Excel Forum Per condividere esperienze su Microsoft Excel

Macro VBA

  • Messaggi
  • OFFLINE
    marym.87
    Post: 1
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 11/10/2018 18:05
    Ciao a tutti, ho disperato bisogno di aiuto nel creare una macro: l'obiettivo è copiare n righe di un foglio(2) in un foglio(1). La chiave tra i due sheet è unica; immaginiamo che la chiave sia (nel foglio 1) nella colonna A; Io vorrei (nel foglio 1) per ogni valore chiave "x" (nella colonna A nel foglio 1) tante righe copiate del foglio 2 se queste righe hanno valore x per la chiave. Concludendo, se nel foglio 1 ho 3 righe con valore chiave x, nel foglio 2 ho 6 righe con il valore chiave x, nel foglio 1 vorrei 3*6=18 righe copiate + le 3 originarie del foglio 1. Vi ringranzio tantissimo
  • OFFLINE
    alfrimpa
    Post: 3.967
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 11/10/2018 18:50
    Ciao Mary

    Allega un file di esempio con i dati ed il risultato voluto inserito a mano.

    Dalla spiegazione che hai dato la cosa non è molto chiara.

    Alfredo
  • OFFLINE
    marym.87
    Post: 1
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 12/10/2018 12:51
    Esempio in allegato
    Spero sia più chiaro,
    Grazie mille

    Maria
  • OFFLINE
    alfrimpa
    Post: 3.968
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 12/10/2018 16:42
    Ciao Maria

    Al momento sono fuori e non ho pc.

    Ti potrò dare riscontro lunedì

    Alfredo
  • OFFLINE
    alfrimpa
    Post: 3.969
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 15/10/2018 11:29
    Ciao Maria

    Spero che tu non abbia abbandonato la discussione [SM=g27828]

    Prova ad eseguire questa macro e dimmi se per te va bene.

    vb
    Sub CopiaMaria()
    Dim i As Long
    Dim ur As Long
    Dim lr As Long
    Dim nVolte As Long
    Dim rng As Range
    Dim cel As Range
    ur = Sheets("Foglio1").Cells(Rows.Count, 1).End(xlUp).Row
    Set rng = Sheets("Foglio1").Range("A2:A" & ur)
    Application.ScreenUpdating = False
    For Each cel In rng
        nVolte = Application.WorksheetFunction.CountIf(Sheets("Foglio2").Range("a2:a51"), cel.Value)
        For i = 1 To nVolte + 1
            lr = Sheets("Risultato").Cells(Rows.Count, 1).End(xlUp).Row
            Sheets("Foglio1").Activate
            Range(Cells(cel.Row, "A"), Cells(cel.Row, "H")).Copy Destination:=Sheets("Risultato").Cells(lr + 1, "A")
        Next i
    Next cel
    Sheets("prova").Activate
    Application.ScreenUpdating = True
    End Sub


    Attenzione: cambia il nome del secondo foglio da "Foglio 2" a "Foglio2"

    Alfredo
  • OFFLINE
    marym.87
    Post: 2
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 15/10/2018 11:34
    No No anzi, a aspettavo ansia!
    Provo subito.

    Grazie mille
  • OFFLINE
    marym.87
    Post: 3
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 15/10/2018 12:13
    Allego il risultato della macro!
    Il risultato della macro lanciata lo trovi nello sheet "Risultato".
    Copia tante righe secondo il criterio desiderato ma poi in colonna H, per le righe aggiunte, devo trovare il valore della colonna G del Foglio2.

    Grazie ancora
    Maria
  • OFFLINE
    alfrimpa
    Post: 3.970
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 15/10/2018 14:19
    Ciao Maria

    Onestamente la faccenda della colonna H non mi è molto chiara.

    Apparentemente non vi è nessuna relazione tra il foglio 1 e 2.

    Ora in A2 del foglio1 abbiamo GISEUCORPBD ed in H2 abbiamo I_GISEUCORBD

    Mi puoi dire in base a quale criterio per ognuna delle 18 righe per ogni voce del foglio1 che andiamo ad aggiungere con la macro sul foglio Risultato debbano essere attribuiti i dati presenti in colonna H del foglio2?

    Io questo non l'ho capito.

    Non so se sono riuscito a spiegarmi.

    Puoi chiarire?
    [Modificato da alfrimpa 15/10/2018 14:19]

    Alfredo
  • OFFLINE
    marym.87
    Post: 4
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 15/10/2018 18:24
    Ciao,

    innanzitutto grazie mille per la disponibilità.
    Il foglio1 e il foglio2 hanno in comunune i valori della colonna A (per entrambi i fogli).
    - Le righe del foglio1 devo rimanere tali;
    - Sotto ogni riga del foglio1 ne devo copiare n uguali con n uguale al numero di righe del foglio2 che hanno lo stesso valore nella colonna A;
    Le righe copiate saranno uguali alla riga padre ad eccezione del valore della colonna H che dovrà essere quello del foglio2.

    Il risultato è esattamente ciò che hai fatto con l'unica differenza che nella colonna H, solo per le righe copiate, devo trovarmi i calore della colonna H del foglio 2.

    Se riguardi il mio file iniziale "risulta" trovi in giallo le righe che io voglio ottenere.

    Grazie ancora
    spero sia piu chiaro
  • OFFLINE
    alfrimpa
    Post: 3.971
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 15/10/2018 19:26
    Si certo Maria tutto questo era chiaro.

    Il punto è che in colonna A del foglio 1 e 2 i valori sono uguali ed allora come si fa ad attribuire per la colonna H valolori diversi?

    I_GISEUCORBD_AX
    I_GISEUCORBD_AY
    I_GISEUCORBD_BX
    I_GISEUCORBD_BY
    I_GISEUCORBD_CD
    I_GISEUCORBD_CX
    I_GISEUCORBD_CY
    I_GISEUCORBD_DX
    I_GISEUCORBD_DY
    I_GISEUCORBD_EX
    I_GISEUCORBD_EY
    I_GISEUCORBD_GX
    I_GISEUCORBD_GY
    I_GISEUCORBD_RX
    I_GISEUCORBD_RY
    I_GISEUCORBD_ZX
    I_GISEUCORBD_ZY

    Non so se sono stato chiaro.

    Alfredo
  • OFFLINE
    alfrimpa
    Post: 3.972
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 15/10/2018 21:44
    Inoltre il numero delle righe da aggiungere è sempre 18 (non credo) o può variare?

    Le lettere che sono in coda alle celle in colonna H del foglio2 sono fisse (non credo) o possono variare?

    Se non chiariamo questi punti è difficile uscirne.

    Alfredo
  • OFFLINE
    marym.87
    Post: 5
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 16/10/2018 09:57
    Nel foglio 1 in colonna A abbiamo i primi due valori uguali, poi cambia e abbiamo gli ultimi 2 uguali.Il file che ho allegato è solo una parte.
    Io mi immagino una macro che deve leggere ogni riga del foglio 1; per ogni riga che sta leggendo va a cercare righe nel foglio 2 con lo stesso valore nella colonna A; le trova e le conta; bene, ne trova n (nel primo caso n=17). A questo punto la riga "in lettura" duplica per n volte se stesso ma deve prendere gli n valori in colonna H di quelle righe che ha trovato con stesso valore in cella A.

    La seconda riga del file1 originario fa lo stesso e trova le stesse righe; copia se stessa per n volte e prende gli n valori della colonna H.

    Nella terza riga (del foglio1) c'è un altro valore nella cella A; cerca le righe del foglio 2 con quel valore nella cella A (anche in questo caso sono 17); copia se stessa per 17 volte e prende i valore della colonna H per quelle 17 righe.

    Possiamo parlarne in chat se può essere più rapida la risoluzione.

    Grazie
    Buona giornata
  • OFFLINE
    alfrimpa
    Post: 3.973
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 16/10/2018 11:50
    Ciao Maria

    Io più o meno ho capito quello che vuoi fare.

    Il problema è tradurlo in macro e sinora ahimè non ci sono ancora riuscito.

    Spero che tu non abbia eccessiva fretta per la risoluzione di questo problema.

    Io intanto continuo a sbattere la testa [SM=g27828] ma non preoccuparti perchè la cosa mi diverte.

    P.S. Scrivere qui o in chat, dal punto di vista della rapidità della soluzione, non cambia gran che.

    Alfredo
  • OFFLINE
    marym.87
    Post: 6
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 16/10/2018 14:32
    Non c'è un modo di dire copia della stessa riga per n volte dalla colonna A alla colonna G e prendi colonna H dal foglio 2?

    Il criterio secondo me è gia corretto e completo cambia solo quello che deve copiare nelle n righe duplicate.

    Grazie veramente, è un lavoro molto importante e risparmierebbe tanto lavoro!

  • OFFLINE
    alfrimpa
    Post: 3.974
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 16/10/2018 15:25
    Re:
    marym.87, 16/10/2018 14.32:

    Non c'è un modo di dire copia della stessa riga per n volte dalla colonna A alla colonna G e prendi colonna H dal foglio 2?



    Probabilmente un modo c'è solo che ion non sono ancora riuscito a trovarlo.

    Intanto continuo a pensarci.



    Alfredo
  • OFFLINE
    dodo47
    Post: 1.947
    Registrato il: 06/04/2013
    Utente Veteran
    2010
    10 16/10/2018 16:35
    Ciao
    Rinomina il Foglio 2 in Foglio2

    Prova

    saluti

    Sub duplicaRighe()
    Dim Sh1 As Worksheet, Sh2 As Worksheet, Sh3 As Worksheet
    Set Sh1 = Worksheets("Foglio1")
    Set Sh2 = Worksheets("Foglio2")
    Set Sh3 = Worksheets("Risultato")
    Ur1 = Sh1.Range("A" & Rows.Count).End(xlUp).Row
    ur2 = Sh2.Range("A" & Rows.Count).End(xlUp).Row
    Sh3.Range("A2:H" & Rows.Count).ClearContents
    r1 = 2
    r2 = 2
    r3 = 2
    For j1 = r1 To Ur1
        codice = Sh1.Cells(j1, 1)
        Sh1.Range("A" & j1 & ":H" & j1).Copy Sh3.Range("A" & r3)
        r3 = r3 + 1
        For j2 = r2 To ur2
            If Sh2.Cells(j2, 1) = codice Then
                Sh1.Range("A" & j1 & ":G" & j1).Copy Sh3.Range("A" & r3)
                Sh3.Cells(r3, 8) = Sh2.Cells(j2, 7)
                r3 = r3 + 1
            End If
        Next j2
    Next j1
    End Sub




    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    marym.87
    Post: 7
    Registrato il: 11/10/2018
    Città: MILANO
    Età: 36
    Utente Junior
    10
    00 16/10/2018 17:46
    Dodo47, semplicemente perfetto!!!

    Ti chiedo solo un'altra cosa.
    Se la colonna H (quella che deve copiare valori dal foglio2) non è l'ultima colonna di dati ma è una colonna centrale ed è sempre l'unica che voglio copiare (le altre colonne devono contenere sempre dati relativi alle righe del foglio1), come va modificata la macro?
    Immaginiamo di avere dati fino alla colonna M.

    Grazie Grazie
  • OFFLINE
    dodo47
    Post: 1.948
    Registrato il: 06/04/2013
    Utente Veteran
    2010
    00 16/10/2018 17:53
    Ciao
    questo:

    Sh3.Cells(r3, 8) = Sh2.Cells(j2, 7)

    copia nella col H di Risultato quanto contenuto nella col G del foglio2

    Vedi tu quello che ti serve

    saluti



    Domenico
    Win 10 - Excel 2016
  • OFFLINE
    GiuseppeMN
    Post: 3.164
    Registrato il: 03/04/2013
    Utente Master
    Excel 2000 - 2013
    00 16/10/2018 19:12
    Buona sera, a Tutti;
    leggo solo ora la Risposta di @dodo47, che saluto; avevo postato già una risposta, poi, vista la Risposta di Domenico l'ho cancellata.
    Ora ho avuto un ripensamento e propongo anch'io un Codice VBA:

    Option Explicit
    
    Sub Test_pg()
    Application.ScreenUpdating = False
    Dim NrP As Long, NR1 As Long, Nr2 As Long, x As Long, y As Long, k As Long
    Dim FgP As Worksheet, Fg1 As Worksheet, Fg2 As Worksheet
        
    Set FgP = Sheets("Risultato")
    Set Fg1 = Sheets("Foglio1")
    Set Fg2 = Sheets("Foglio2")
        FgP.Activate
            NrP = Range("A" & Rows.Count).End(xlUp).Row
                If NrP < 2 Then NrP = 2
            Range(Cells(2, 1), Cells(NrP, 8)).ClearContents
            Range(Cells(2, 1), Cells(NrP, 8)).Interior.Pattern = xlNone
                k = 2
        Fg1.Activate
            NR1 = Range("A" & Rows.Count).End(xlUp).Row
        Fg2.Activate
            Nr2 = Range("A" & Rows.Count).End(xlUp).Row
        For x = 2 To NR1
            Fg1.Activate
                Fg1.Range(Cells(x, 1), Cells(x, 8)).Copy
            FgP.Activate
                Cells(k, 1).PasteSpecial Paste:=xlValues
                Range(Cells(k, 1), Cells(k, 8)).Interior.Color = 65535
                    
            For y = 2 To Nr2
                If Fg2.Cells(y, 1) = Cells(y, 1) Then
                    k = k + 1
                        Range(Cells(x, 1), Cells(x, 7)).Copy
                        Cells(k, 1).PasteSpecial Paste:=xlValues
                            Fg2.Cells(y, 7).Copy
                        Cells(k, 8).PasteSpecial Paste:=xlValues
                End If
            Next y
                k = k + 1
        Next x
    Set FgP = Nothing
    Set Fg1 = Nothing
    Set Fg2 = Nothing
    Application.ScreenUpdating = True
        Cells(2, 1).Select
    End Sub
    


    P.s. Dovrebbe evidenziare in giallo solo i Record uguali a Foglio1; così, in caso di stampa ... risparmiamo il tonner! [SM=x423030]


    Buona serata

    Giuseppe

    Windows XP - Excel 2000
    Windows 10 - Excel 2013
  • OFFLINE
    alfrimpa
    Post: 3.975
    Registrato il: 21/06/2013
    Città: NAPOLI
    Età: 70
    Utente Master
    Excel 365
    00 17/10/2018 11:46

    Quando il gioco si fa duro i duri cominciano a giocare [SM=g27828]



    Sinceri complimenti a Domenico e Giuseppe.

    Io mi ero incartato sull'ultimo punto.

    Alfredo
  • OFFLINE
    GiuseppeMN
    Post: 3.171
    Registrato il: 03/04/2013
    Utente Master
    Excel 2000 - 2013
    00 17/10/2018 12:33
    Buona giornata, Alfredo;
    grazie della tua attenzione, ma, ad onor del vero nel Codice VBA che ho proposto c'è un refuso.

    Non chiedermi il perchè, forse un improvvido Copia/Incolla, ma la Condizione:
     If Fg2.Cells(y, 1) = Cells(y, 1) Then 

    nel codice con il quale ho condotto i miei test in realtà è:
     If Fg2.Cells(y, 1) = Cells(x, 1) Then 


    Il Codice che ho allegato non crea problemi relativamente all'esempio proposo da @marym.87 ma in determinate circosanze potrebbe creare disservizio.

    Tanto è dovuto per opportuna chiarezza.


    A disposizione.

    Giuseppe

    Windows XP - Excel 2000
    Windows 10 - Excel 2013
  • 15MediaObject5,00121 1