Werte mehrerer Zeilen zusammenfassen in eine Zelle

Liebe Herber-Gemeinde,
ich habe ein großes Problem, eine Datei mit 77.000 Zeilen, deren Werte der Saplte V beim Vorliegen gleicher Einträge in bestimmten Spalten zusammengefasst werden müssen. Ich habe das Makro mal in Worte umformuliert.
Gehe in Spalte B und suche in Spalte B die nächste GID. Dann vergleiche, ob die Inhalte der Spalten A, P und S JEWEILS identisch sind. Wenn ja, dann nehme die erste Zeile der entsprechenden GID, kopiere diese auf Tabellenblatt 2 und füge alle Werte der Saplte V durch Semikolon getrennt in die Saplte V.
Wenn die Werte der Spalte A nicht identisch ist, Spalte O und Spalte S jedoch jeweils identischen Inhalt haben, dann füge alle Werte der Spalte V in einer Zelle zusammen (getrennt durch Semikolon) und nehme für die Spalte A (auf Tab. 2) den Wert der ersten Zeile aus Spalte A (von Tab 1). Ein Beispiel ist beigefügt, mit der Wünschlösung auf Tabellenblatt 2.
https://www.herber.de/bbs/user/99688.xlsx
Herzlichen Dank für eine Hilfe.
Grüße, Bernd

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Option Explicit Public i, lngErste, lngRow As Long Public intLetzte Public strKost As String Sub Zusammenstellen() Dim lngLetzte As Long lngRow = 2 lngErste = 3 With Sheets(1) lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row intLetzte = .Cells(3, Columns.Count).End(xlToLeft).Column strKost = .Cells(3, 22).Value Application.ScreenUpdating = False For i = 3 To lngLetzte If Not IsEmpty(.Cells(i, 2)) Then If .Cells(i, 2).Value = .Cells(i + 1, 2).Value Then If .Cells(i, 15).Value = .Cells(i + 1, 15).Value Then If .Cells(i, 19).Value = .Cells(i + 1, 19).Value Then If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then .Cells(i, 1).Value = .Cells(i + 1, 1).Value strKost = strKost & "; " & .Cells(i + 1, 22).Value Else: strKost = strKost & "; " & .Cells(i + 1, 22).Value End If Else: Call Uebertragen End If Else: Call Uebertragen End If Else: Call Uebertragen End If Else: strKost = .Cells(i + 1, 22).Value: lngErste = i + 1 End If Next i End With Application.ScreenUpdating = True End Sub Private Sub Uebertragen() Dim rng As Range With Sheets(1) .Range(.Cells(lngErste, 1), .Cells(lngErste, intLetzte)).Copy Worksheets(2).Cells(lngRow, 1).PasteSpecial Paste:=xlValues Application.CutCopyMode = False Sheets(2).Cells(lngRow, 22) = strKost strKost = .Cells(i + 1, 2).Value lngRow = lngRow + 1 lngErste = i + 1 End With End Sub

Hallo Bernd,
ich hatte vergessen eine Variable richtig zu deklarieren.

Option Explicit
Public i, lngErste, lngRow As Long
Public intLetzte As Integer
Public strKost As String

Sub Zusammenstellen()
Dim lngLetzte As Long
lngRow = 2
lngErste = 3
 With Sheets(1)
    lngLetzte = .Cells(Rows.Count, 1).End(xlUp).Row
    intLetzte = .Cells(3, Columns.Count).End(xlToLeft).Column
    strKost = .Cells(3, 22).Value
Application.ScreenUpdating = False
    For i = 3 To lngLetzte
      If Not IsEmpty(.Cells(i, 2)) Then
        If .Cells(i, 2).Value = .Cells(i + 1, 2).Value Then
          If .Cells(i, 15).Value = .Cells(i + 1, 15).Value Then
            If .Cells(i, 19).Value = .Cells(i + 1, 19).Value Then
              If .Cells(i, 1).Value <> .Cells(i + 1, 1).Value Then
                .Cells(i, 1).Value = .Cells(i + 1, 1).Value
                strKost = strKost & "; " & .Cells(i + 1, 22).Value
                Else: strKost = strKost & "; " & .Cells(i + 1, 22).Value
              End If
            Else: Call Uebertragen
            End If
          Else: Call Uebertragen
          End If
        Else: Call Uebertragen
        End If
      Else: strKost = .Cells(i + 1, 22).Value: lngErste = i + 1
      End If
    Next i
  End With
Application.ScreenUpdating = True
End Sub

Private Sub Uebertragen()
Dim rng As Range
With Sheets(1)
    .Range(.Cells(lngErste, 1), .Cells(lngErste, intLetzte)).Copy
    Worksheets(2).Cells(lngRow, 1).PasteSpecial Paste:=xlValues
    Application.CutCopyMode = False
    Sheets(2).Cells(lngRow, 22) = strKost
    strKost = .Cells(i + 1, 2).Value
    lngRow = lngRow + 1
    lngErste = i + 1
End With
End Sub

Gruß
Alex

Beliebteste Forumthreads (12 Monate)

Werte mehrerer Zeilen zusammenfassen in eine Zelle

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte mehrerer Zeilen zusammenfassen in eine Zelle

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

317 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread