Microsoft Excel

Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
BildScreenshot zu MsgBox MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Dublikate zusammenfassen per VBA

Betrifft: Dublikate zusammenfassen per VBA von: Artanan
Geschrieben am: 14.11.2014 15:32:16

Hallo

ich habe eine Tabelle mit Dublikaten (seriennummern). da aber in manchen spalten trotzdem unterschiedliche einträge sind, möchte ich die dublikate nicht löschen sondern in einer zeile zusammenfassen. dazu füge ich die zellinhalte einfach in einer zelle als mehrzeiler zusammen.

folgenden code habe ich geschrieben:

 letztespalte = Sheets(a).Cells(1, 256).End(xlToLeft).Column
 
  For h = Sheets(a).Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
  
         If Sheets(a).Cells(h, 1) = Sheets(a).Cells(h - 1, 1) Then
  
             For j = 2 To letztespalte            
             Sheets(a).Cells(h - 1, j) = Sheets(a).Cells(h, j) & Chr(10) & Sheets(a).Cells(h -  _
1, j)
             Next

  Sheets(a).Rows(h).Delete
        End If
  
Next
ich würde jetzt gerne noch einbauen, dass gleiche eintäge nicht zusammengefügt werden. das geht mit meiner methode aber schlecht, da ich ja einen mehrzeiler generiere.
hat hier jmd eine bessere idee?

Beispieldatei zur verdeutlichung ohne code habe ich mal angehängt:

https://www.herber.de/bbs/user/93774.xlsx

  

Betrifft: AW: Dublikate zusammenfassen per VBA von: Tino
Geschrieben am: 14.11.2014 17:32:13

Hallo,
kannst mal so versuchen.
Da ich Deinen genauen aufbau nicht kenne, bin ich vom Beispiel ausgegangen.
Hinweis: Die Datei nicht als xlms, xlsb oder xls speichern, xlsx kann kein VBA!

Sub Test()
Dim ArErg, ArData
Dim oDic(2) As Object
Dim n&
Dim sUmbruch$, sTemp$

On Error GoTo ErrorHandler

Application.ScreenUpdating = False
Application.EnableEvents = False

For n = 0 To 2
    Set oDic(n) = CreateObject("Scripting.Dictionary")
Next n

'Datenbereich evtl. anpassen 
With Tabelle1
    ArData = .Range("B3:D9")
End With

For n = Ubound(ArData) To 1 Step -1
    sUmbruch = IIf(oDic(1)(ArData(n, 1)) <> "", Chr(10), "")
    oDic(0)(ArData(n, 1)) = ArData(n, 1)
    sTemp = ArData(n, 2)
    If InStr(oDic(1)(ArData(n, 1)), sTemp) > 0 Then sTemp = ""
    oDic(1)(ArData(n, 1)) = sTemp & sUmbruch & oDic(1)(ArData(n, 1))
    oDic(2)(ArData(n, 1)) = ArData(n, 3) & sUmbruch & oDic(2)(ArData(n, 1))
Next n

'Ausgabe 
With Tabelle1
    With .Range("B17") 'erste einfüge Zelle 
        'alte Daten löschen 
        .Parent.Range(.Cells, .Parent.Cells(.Parent.Rows.Count, .Column)).Resize(, 3).Clear
        'einfügen und Formatieren 
        If oDic(0).Count > 0 Then
            With .Resize(oDic(0).Count, 3)
                .WrapText = True
                .Columns(1).Value = Application.Transpose(oDic(0).items)
                .Columns(2).Value = Application.Transpose(oDic(1).items)
                .Columns(3).Value = Application.Transpose(oDic(2).items)
                .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, Header:=xlNo
                .Borders(xlEdgeLeft).Weight = xlMedium
                .Borders(xlEdgeRight).Weight = xlMedium
                .Borders(xlEdgeBottom).Weight = xlMedium
                .EntireRow.AutoFit
            End With
        End If
    End With
End With

ErrorHandler:

Application.ScreenUpdating = True
Application.EnableEvents = True

If Err.Number <> 0 Then
    MsgBox Err.Description, _
           vbCritical + vbMsgBoxSetForeground + vbMsgBoxHelpButton, _
           "Error: " & Err.Number, Err.HelpFile, Err.HelpContext
End If
End Sub
Gruß Tino


  

Betrifft: die Variable ArErg kannst Du löschen oT. von: Tino
Geschrieben am: 14.11.2014 17:33:08




  

Betrifft: AW: Dublikate zusammenfassen per VBA von: Artanan
Geschrieben am: 18.11.2014 09:59:45

Hi tino,

erstmal vielen dank und sorry für meine späte antwort.
ich habe durch meine beispieldatei wohl etwas verwirrt.
du hast es natürlich so interpretiert, wie ich es dargestellt habe.

ich meinte allerdings eher eine zusammenfassung in der ursprünglichen zeile. also keine ausgabe in b17 etc. sondern eine ersätzung der gleichen zeilen.

sorry für die verwirrende datei. ich habe nochmal eine datei hochgeladen mit 2 blättern(vorher und nachher), welche jetzt sehr nah am original ist. ich hoffe dadurch wird es klarer.
das ganze soll natürlich im gleichen tabellenblatt ablaufen und nicht in 2 verschiedenen.

https://www.herber.de/bbs/user/93846.xlsm


 

Beiträge aus den Excel-Beispielen zum Thema "Dublikate zusammenfassen per VBA"