Come unire le righe con lo stesso nome unendo i dati di ogni colonna correlata


0

Devo unire le righe con lo stesso nome preservando i dati di ogni colonna. Ad esempio, se abbiamo due righe con il nome "Mr Bean" sulla prima colonna "Nome", quindi uniamo i dati di ciascuna colonna relativi alle righe denominate "Mr Bean", quindi elimina la seconda e la terza riga, mettendo tutti i dati in solo la prima riga denominata "Mr Bean". Quindi, dovremmo avere tutti i dati relativi a una singola persona in una riga anziché in più di una riga.

+-------------------------------------------------------+
| Column Name   Column 2   Column 3   Column 4 Column 5 |
| Mr Bean        2           3                          |
| Mr Bean                    2          3        5      |
| Mr X           3                      3               |
| Mr Y           2           4          1        3      |
+-------------------------------------------------------+

Uscita desiderata:

+-------------------------------------------------------+
| Column Name  Column 2    Column 3   Column 4 Column 5 |
| Mr Bean        2         3, 2          3        5     |
| Mr X           3                       3              |
| Mr Y           2          4            1        3     |
+-------------------------------------------------------+

Il mio file Excel ha circa 4000 righe e 450 colonne.


1
Vorrei iniziare con questa risposta e vedere come ottenere i valori da combinare anziché sovrascrivere.
Raystafarian,

Risposte:


1

Questo dovrebbe fare quello che vuoi, modificare secondo le tue necessità -

Sub combine()
Application.ScreenUpdating = False
Dim c As Range
Dim i As Integer

For Each c In Range("A2", Cells(Cells.SpecialCells(xlCellTypeLastCell).Row, 1))
Label:
If c = c.Offset(1) And c <> "" Then
       For i = 1 To 4
            If c.Offset(1, i) <> "" Then
                If c.Offset(, i) = "" Then
                c.Offset(, i) = c.Offset(1, i)
                Else: c.Offset(, i) = c.Offset(, i) & "," & c.Offset(1, i)
                End If
            End If
       Next
       c.Offset(1).EntireRow.Delete
       GoTo Label
End If

Next
Application.ScreenUpdating = True
End Sub
Utilizzando il nostro sito, riconosci di aver letto e compreso le nostre Informativa sui cookie e Informativa sulla privacy.
Licensed under cc by-sa 3.0 with attribution required.