Microsoft Excel

Herbers Excel/VBA-Archiv

Inhalte zusammenführen | Herbers Excel-Forum


Betrifft: Inhalte zusammenführen von: Space
Geschrieben am: 20.01.2010 16:44:29

Hallo,

ich habe mal eine Beispieldatei von meinem Problem ins Forum gestellt. Ich würde gerne die doppelten Werte in einer Spalte zusammenfassen und die zugehörigen Werte in der 2 Spalte mit einem Komma getrennt in die passende Zelle schreiben.

Vielen Dank für eure Hilfe, hier der Link https://www.herber.de/bbs/user/67352.xls

Gruß
Space

  

Betrifft: Werte zusammenfassen von: NoNet
Geschrieben am: 20.01.2010 17:05:22

Hallo Space,

das kannst Du mit folgendem Makro lösen :

Sub Zusammenfassung()
    Dim lngZ1 As Long, lngZ2 As Long
    
    For lngZ1 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
        If Application.CountIf(Range(Cells(2, 1), Cells(lngZ1, 1)), Cells(lngZ1, 1)) = 1 Then
            Cells(Rows.Count, 3).End(xlUp).Offset(1) = Cells(lngZ1, 1)
            Cells(Rows.Count, 3).End(xlUp).Offset(, 1) = Cells(lngZ1, 2)
        Else
            lngZ2 = 1 + Application.Match(Cells(lngZ1, 1), Range("C2:C" & lngZ1), 0)
            Cells(lngZ2, 4) = Cells(lngZ2, 4) & ", " & Cells(lngZ1, 2)
        End If
    Next
End Sub
Gruß, NoNet


  

Betrifft: AW: Inhalte zusammenführen von: Tino
Geschrieben am: 20.01.2010 17:05:27

Hallo,
teste mal diesen Code.

Sub Test()
Dim meAR(), meDic As Object
Dim A As Long

Set meDic = CreateObject("Scripting.Dictionary")
meAR = Range("A2", Cells(Rows.Count, 2).End(xlUp)).Value2

For A = 1 To Ubound(meAR)
 If meDic.exists(meAR(A, 1)) Then
    meDic(meAR(A, 1)) = meDic(meAR(A, 1)) & ", " & meAR(A, 2)
 Else
    meDic(meAR(A, 1)) = meAR(A, 2)
 End If
Next A

With Application
    Range("A2").Resize(Ubound(meAR), 2).ClearContents
    Range("A2").Resize(meDic.Count) = .Transpose(meDic.keys)
    Range("B2").Resize(meDic.Count) = .Transpose(meDic.items)
End With

End Sub
Gruß Tino


  

Betrifft: AW: Inhalte zusammenführen von: Space
Geschrieben am: 21.01.2010 07:58:37

Sorry, für die späte Rückmeldung. Habe den Code eingebaut. Mit meinem kleinen Beispiel hat alles super funktioniert. Werde es im Laufe des Tages auf eine Excel Tabelle mit 25.000 Zeilen ausweiten. Wenn ich noch Fragen haben sollte melde ich mich!

Vielen Dank euch beiden!
Gruß
Space


  

Betrifft: AW: Inhalte zusammenführen von: Space
Geschrieben am: 21.01.2010 08:23:19

Morgen,

es ergibt sich gleich die nächste Frage: kann man das auch für weitere Spalten definieren. Also, dass die Inhalte in Spalte 4,5,6,7,8 ... auch zusammengefasst werden.

Der zweite Code ist mir lieber, da er den Rest bereits löscht und oben bei A1 anfängt. Vielleicht kann mir jemand kurz beschreiben, was da passiert und wie man das Problem lösen kann.

Vielen Dank!


  

Betrifft: AW: Inhalte zusammenführen von: Tino
Geschrieben am: 21.01.2010 08:58:52

Hallo,
müsste funktionieren.

Sub Test()
Dim meAR(), meDic(1 To 6) As Object
Dim A As Long, AA As Long

For A = 1 To 6
Set meDic(A) = CreateObject("Scripting.Dictionary")
Next A

meAR = Range("A2", Cells(Rows.Count, 8).End(xlUp)).Value2

For A = 1 To Ubound(meAR)
 If meDic(1).exists(meAR(A, 1)) Then
    meDic(1)(meAR(A, 1)) = meDic(1)(meAR(A, 1)) & ", " & meAR(A, 2) 'Spalte B 
    meDic(2)(meAR(A, 1)) = meDic(2)(meAR(A, 1)) & ", " & meAR(A, 4) 'Spalte D 
    meDic(3)(meAR(A, 1)) = meDic(3)(meAR(A, 1)) & ", " & meAR(A, 5) 'Spalte E 
    meDic(4)(meAR(A, 1)) = meDic(4)(meAR(A, 1)) & ", " & meAR(A, 6) 'Spalte F 
    meDic(5)(meAR(A, 1)) = meDic(5)(meAR(A, 1)) & ", " & meAR(A, 7) 'Spalte G 
    meDic(6)(meAR(A, 1)) = meDic(6)(meAR(A, 1)) & ", " & meAR(A, 8) 'Spalte H 
 Else
    For AA = 1 To 6
     meDic(AA)(meAR(A, 1)) = meAR(A, 2)
    Next AA
 End If
Next A

With Application
    Range("A2").Resize(Ubound(meAR), 8).ClearContents
    Range("A2").Resize(meDic(1).Count) = .Transpose(meDic(1).keys)
    Range("B2").Resize(meDic(1).Count) = .Transpose(meDic(1).items)
    Range("D2").Resize(meDic(2).Count) = .Transpose(meDic(2).items)
    Range("E2").Resize(meDic(3).Count) = .Transpose(meDic(3).items)
    Range("F2").Resize(meDic(4).Count) = .Transpose(meDic(4).items)
    Range("G2").Resize(meDic(5).Count) = .Transpose(meDic(5).items)
    Range("H2").Resize(meDic(6).Count) = .Transpose(meDic(6).items)
End With

End Sub
Aber was ist mit Deiner Spalte 3?
Im Beispiel war es die die Spalte 2 und bei Deiner zweiten Frage geht es erst ab Spalte 4 weiter?

Gruß Tino


  

Betrifft: AW: Inhalte zusammenführen von: Space
Geschrieben am: 21.01.2010 09:47:21

Stimmt, hast recht ;)! Habe Spalte 3 vergessen, wollte Sie aber mit drinnen haben ... Jetzt hab ich ja den Code und füge Spalte 3 einfach ein!

Vielen Dank für deine Hilfe !!!!!!

Gruß
Space


Beiträge aus den Excel-Beispielen zum Thema "Inhalte zusammenführen"