Datensätze zusammenfügen mittels VBA

[joshua]

Hallo Comunnity!
Ich würde gerne Datensätze mittels VBA zusammenfügen.
Ich habe bereits in meine Buch dazu die Funktion "Join" herausfinden können.
Leider weiß ich nun nicht, wie ich die Schleife gestalten soll.

Ziel ist es, in der jeweiligen ersten Zeile in F, von jeder Gruppe (aus Spalte E), jeweils alle Werte, getrennt mit einem ";", aufzulisten. Entsprechend alle anderen Werte dadrunter zu löschen.

[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]

[snb]

Code:

Sub M_snb()
   sn=array("a1","A2")
   msgbox join(sn,",")
End Sub

oder

Code:

Sub M_snb()
   msgbox join(array("a1","A2"),",")
End Sub

Code:

sub M_snb()
   msgbox join(application.transpose(columns(5).specialcells(2)),",")
end sub

NB. Benütze immer Zelle A1

[joshua]

Hallo Stefan, vielen Dank für Deine Lösung (:

geht der Ansatz auch ohne Msgbox?

Tut mir leid, dass ich das vergessen habe zu erwähne. In allen anderen Zeilen/ Zellen (inklusive A1) sind auch Werte enthalten, die jedoch nicht relevant sind.

[snb]

Stefan   wo ? wie ? wann ? wozu ?

[atilla]

Hallo Joshua,

schau mal unter folgendem Link habe ich das Gleiche schon mal gelöst: http://www.clever-excel-forum.de/thread-...l#pid71591

Da die Gruppen ermittelt werden müssen, geht es hier mit Dictionary.

[joshua]

Entschuldige snb, meinte natürlich Sebastian.

Hallo atilla, vielen lieben Dank! (:

Ich scheitere leider noch daran, den code nachzuvollziehen :/
Ich bin zwar mit F8 Schritt für Schritt den Code durchgegangen, scheitere jedoch an der Adaption.

Code:

Sub JoinDataSets()

   Dim i As Long, j As Long
   Dim lngZ As Long
   Dim arr As Variant
   Dim varK
   Dim D1 As Object
   
   Set D1 = CreateObject("Scripting.Dictionary")

   Application.ScreenUpdating = False

   With Worksheets("Tabelle1")
   
     lngZ = .Cells(.Rows.Count, 1).End(xlUp).Row
       arr = .Range("D2:E" & lngZ)
       For i = 1 To UBound(arr)
         D1(arr(i, 1)) = D1(arr(i, 1)) & "," & arr(i, 2)
       Next i
       
       Range("D2").CurrentRegion.Offset(1, 0).Resize(, Range("D2").CurrentRegion.Columns.Count).ClearContents
       
       For Each varK In D1.Keys
           .Cells(j + 1, 4) = varK
           .Cells(j + 1, 5) = Mid(D1(varK), 2)
           j = j + 1
       Next
       
   End With
   
End Sub

[snb]

Sebastian [img]
Dateiupload bitte im Forum! So geht es: Klick mich!
]  wo ? wie ? wann ? wozu ? 

Verzichte auf unbekannntee Namen, bitte; verwende die Alias 'snb'.

[atilla]

Hallo Joshua,

dann teste mal:

Code:

Sub mach_wieder()
  Dim i As Long, j As Long
  Dim lngZ As Long

  Dim arr As Variant
  Dim varK
  Dim D1 As Object
  Set D1 = CreateObject("Scripting.Dictionary")

  Application.ScreenUpdating = False

  With Worksheets("Tabelle1")
    lngZ = .Cells(.Rows.Count, 5).End(xlUp).Row
      arr = .Range("E2:F" & lngZ)
      For i = 1 To UBound(arr)
        D1(arr(i, 1)) = D1(arr(i, 1)) & "," & arr(i, 2)
      Next i
      Range("H2").CurrentRegion.Offset(1, 0).Resize(, Range("D2").CurrentRegion.Columns.Count).ClearContents
      For Each varK In D1.Keys
          .Cells(j + 1, 8) = varK
          .Cells(j + 1, 9) = Mid(D1(varK), 2)
          j = j + 1
      Next
  End With
 
End Sub

Ich schreibe die zusammengefügten Teile in Spalte I, und die muss als TEXT formatiert sein.

[joshua]

Hallo atilla,

leider funktioniert der Ansatz bisher nicht :/

De Tabelle hat einen Umfang von A1:S400 (mit Überschriften)
Ich habe versucht die Tabelle zu adaptieren, scheitere jedoch kläglich.

Anbei nochmal eine Mustertabelle, welche die Struktur besser wiedergibt.

Code:

Sub JoinDataSets()

  Dim i As Long, j As Long
  Dim lngZ As Long
  Dim arr As Variant
  Dim varK
  Dim D1 As Object
  Set D1 = CreateObject("Scripting.Dictionary")

  Application.ScreenUpdating = False

  With Worksheets("tblOne")
    lngZ = .Cells(.Rows.Count, 5).End(xlUp).Row
      arr = .Range("E2:F" & lngZ)
      For i = 2 To UBound(arr)
        D1(arr(i, 1)) = D1(arr(i, 1)) & "," & arr(i, 2)
      Next i
      Range("T2").CurrentRegion.Offset(1, 0).Resize(, Range("D2").CurrentRegion.Columns.Count).ClearContents
      For Each varK In D1.Keys
          .Cells(j + 1, 21) = varK
          .Cells(j + 1, 22) = Mid(D1(varK), 2)
          j = j + 1
      Next
  End With
 
End Sub

Vielleicht habe ich mal wieder das Problem zu wage beschrieben. Hier ist nochmal ein Bild, welches Ziel relativ gut erkennen lässt.
[url=
Dateiupload bitte im Forum! So geht es: Klick mich!
]
Für jede Auswirkung in Spalte E möchte ich gerne alle Folgen in Spalte F, jeweils in der obersten Zeile, summiert haben. Die anderen entsprechend leeren.

[schauan]

Hallöchen,

der Code schreibt z.B.
Auswirkung X Folge 1,Folge 2,Folge 2
Wie soll es denn aussehen?
z.B.
Auswirkung X 2xFolge 1, 2xFolge 2

oder sollen aus den 4 Zeilen 2 werden?
Auswirkung X Folge 1 20 ... 48
Auswirkung X Folge 2 20 ... 48

Wenn ja, sollen auch die Spalten A, C, Q und S summiert werden?

Eventuell kann man das auch mit einer Pivottabelle lösen.