Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Macro unione celle su più righe

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Macro unione celle su più righe

Postdi oz85 » 06/08/18 12:25

Ciao a tutti ragazzi!

Torno a scrivere dopo le ferie fatte per un problema al quale non so bene come approcciare.

Ho due file excel, un primo file A (quello che vedete sotto) che ha una serie di celle unite in base ad un criterio e un altro file B che ha gli stessi dati ma replica le celle unite con singole celle riportando lo stesso valore che prima era contenuto nell'unica cella unita.

Il mio quesito è il seguente: si può sviluppare una macro che passi in rassegna il file B che ha le singole righe NON unite, facendogli unire le celle? sostanzialmente, riportare le colonne evidenziate com'erano prima? La logica con la quale bisognerebbe unire le celle è data dalla stessa partenza/arrivo, che potete vedere nelle colonne H (Partenza) e P (Arrivo). Sostanzialmente, laddove questi valori siano uguali occorre unire le celle adiacenti. Credo che occorra farlo utilizzando un For ma non sono molto pratico con questa funzione.

Qualche buon samaritano potrebbe aiutarmi? Allego lo screen. Grazie!

Immagine
oz85
Utente Junior
 
Post: 92
Iscritto il: 26/03/18 14:35

Sponsor
 

Re: Macro unione celle su più righe

Postdi Anthony47 » 06/08/18 14:22

Riesci a pubblicare un file dimostrativo su cui lavorare?
Avatar utente
Anthony47
Moderatore
 
Post: 17658
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro unione celle su più righe

Postdi oz85 » 07/08/18 09:37

Anthony47 ha scritto:Riesci a pubblicare un file dimostrativo su cui lavorare?


Eccomi grazie!

Qui i due file:
https://mega.nz/#F!zIUFhART!jvPAWmzgdz2XwO7wB433Rw

Qui invece due screen d'esempio di quello che cerco di realizzare:
https://postimg.cc/gallery/33a7w8662/


Grazie!
oz85
Utente Junior
 
Post: 92
Iscritto il: 26/03/18 14:35

Re: Macro unione celle su più righe

Postdi Anthony47 » 08/08/18 01:43

Una macro che fa modifica FileB come richiesto (meglio: come io ho capito) potrebbe essere la seguente:
Codice: Seleziona tutto
Sub cJoin()
Dim iCols, I As Long, J As Long, JRows As Long
'
iCols = Array("C", "K")
For J = 0 To UBound(iCols)
    For I = 1 To Cells(Rows.Count, iCols(J)).End(xlUp).Row
    If Cells(I, iCols(J)).Offset(0, 2).MergeCells = False Then
        If Cells(I, iCols(J)) = Cells(I + 1, iCols(J)) And _
           Cells(I, iCols(J)).Offset(0, 1) = Cells(I + 1, iCols(J)).Offset(0, 1) And _
           Cells(I, iCols(J)).Offset(0, 2) = Cells(I + 1, iCols(J)).Offset(0, 2) Then
            JRows = JRows + 1
        Else
            If JRows > 0 Then
                Application.DisplayAlerts = False
                With Cells(I - JRows, iCols(J)).Offset(0, 2).Resize(JRows + 1, 1)
                    .VerticalAlignment = xlCenter
                    .MergeCells = False
                    .Merge
                End With
                Application.DisplayAlerts = True
                JRows = 0
            End If
        End If
    End If
    Next I
Next J
End Sub


Prova e fai sapere
Avatar utente
Anthony47
Moderatore
 
Post: 17658
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro unione celle su più righe

Postdi oz85 » 08/08/18 14:50

Magnifico Anthony! Grazie davvero tante, non pensavo si riuscisse a fare una cosa del genere. Rapidamente, senza entrare nel merito mi fai capire la logica?

Grazie!!


Anthony47 ha scritto:Una macro che fa modifica FileB come richiesto (meglio: come io ho capito) potrebbe essere la seguente:
Codice: Seleziona tutto
Sub cJoin()
Dim iCols, I As Long, J As Long, JRows As Long
'
iCols = Array("C", "K")
For J = 0 To UBound(iCols)
    For I = 1 To Cells(Rows.Count, iCols(J)).End(xlUp).Row
    If Cells(I, iCols(J)).Offset(0, 2).MergeCells = False Then
        If Cells(I, iCols(J)) = Cells(I + 1, iCols(J)) And _
           Cells(I, iCols(J)).Offset(0, 1) = Cells(I + 1, iCols(J)).Offset(0, 1) And _
           Cells(I, iCols(J)).Offset(0, 2) = Cells(I + 1, iCols(J)).Offset(0, 2) Then
            JRows = JRows + 1
        Else
            If JRows > 0 Then
                Application.DisplayAlerts = False
                With Cells(I - JRows, iCols(J)).Offset(0, 2).Resize(JRows + 1, 1)
                    .VerticalAlignment = xlCenter
                    .MergeCells = False
                    .Merge
                End With
                Application.DisplayAlerts = True
                JRows = 0
            End If
        End If
    End If
    Next I
Next J
End Sub


Prova e fai sapere
oz85
Utente Junior
 
Post: 92
Iscritto il: 26/03/18 14:35

Re: Macro unione celle su più righe

Postdi Anthony47 » 08/08/18 23:27

Ripubblico la macro con qualche ricco commento:
Codice: Seleziona tutto
Sub cJoin()
Dim iCols, I As Long, J As Long, JRows As Long
'
iCols = Array("C", "K")         'Le colonne da dove esaminare
For J = 0 To UBound(iCols)      'un ciclo per ogni colonna
    For I = 1 To Cells(Rows.Count, iCols(J)).End(xlUp).Row
    If Cells(I, iCols(J)).Offset(0, 2).MergeCells = False Then     'Se la cella e' "unita", allora ignora
        'Controllo se le tre colonne siano uguali alla riga successiva:
        If Cells(I, iCols(J)) = Cells(I + 1, iCols(J)) And _
           Cells(I, iCols(J)).Offset(0, 1) = Cells(I + 1, iCols(J)).Offset(0, 1) And _
           Cells(I, iCols(J)).Offset(0, 2) = Cells(I + 1, iCols(J)).Offset(0, 2) Then
            JRows = JRows + 1       'Se SI, conta
        Else
            'Se No, controlla se ci sono celle precedenti da unire
            If JRows > 0 Then       'se >0 ci sono celle da unire
                Application.DisplayAlerts = False
                'si selezionano le celle da unire:
                With Cells(I - JRows, iCols(J)).Offset(0, 2).Resize(JRows + 1, 1)
                    .VerticalAlignment = xlCenter   'si allinea al centro
                    .MergeCells = False             'si "disunisce", se ci fossero celle unite
                    .Merge                          'si Unisce
                End With
                Application.DisplayAlerts = True
                JRows = 0
            End If
        End If
    End If
    Next I                  'Si ripete rigo, fino alla fine
Next J                      'si ripete per blocco colonne
End Sub

Ciao
Avatar utente
Anthony47
Moderatore
 
Post: 17658
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Macro unione celle su più righe

Postdi oz85 » 09/08/18 11:08

Grazie Anthony per la pazienza! gentilissimo!

Anthony47 ha scritto:Ripubblico la macro con qualche ricco commento:
Codice: Seleziona tutto
Sub cJoin()
Dim iCols, I As Long, J As Long, JRows As Long
'
iCols = Array("C", "K")         'Le colonne da dove esaminare
For J = 0 To UBound(iCols)      'un ciclo per ogni colonna
    For I = 1 To Cells(Rows.Count, iCols(J)).End(xlUp).Row
    If Cells(I, iCols(J)).Offset(0, 2).MergeCells = False Then     'Se la cella e' "unita", allora ignora
        'Controllo se le tre colonne siano uguali alla riga successiva:
        If Cells(I, iCols(J)) = Cells(I + 1, iCols(J)) And _
           Cells(I, iCols(J)).Offset(0, 1) = Cells(I + 1, iCols(J)).Offset(0, 1) And _
           Cells(I, iCols(J)).Offset(0, 2) = Cells(I + 1, iCols(J)).Offset(0, 2) Then
            JRows = JRows + 1       'Se SI, conta
        Else
            'Se No, controlla se ci sono celle precedenti da unire
            If JRows > 0 Then       'se >0 ci sono celle da unire
                Application.DisplayAlerts = False
                'si selezionano le celle da unire:
                With Cells(I - JRows, iCols(J)).Offset(0, 2).Resize(JRows + 1, 1)
                    .VerticalAlignment = xlCenter   'si allinea al centro
                    .MergeCells = False             'si "disunisce", se ci fossero celle unite
                    .Merge                          'si Unisce
                End With
                Application.DisplayAlerts = True
                JRows = 0
            End If
        End If
    End If
    Next I                  'Si ripete rigo, fino alla fine
Next J                      'si ripete per blocco colonne
End Sub

Ciao
oz85
Utente Junior
 
Post: 92
Iscritto il: 26/03/18 14:35


Torna a Applicazioni Office Windows


Topic correlati a "Macro unione celle su più righe":


Chi c’è in linea

Visitano il forum: Marius44 e 53 ospiti