ich habe ein Excel Dokument mit 4 Spalten A,B,C,D.
Nun möchte ich, dass für jede Zeile 3 Spalten verglichen werden außer A1,B1,C1 in welchen die Überschriften stehen.
Steht nun in Zelle A2,A3,A4 ein identischer Wert genauso wie in Zelle B2,B3,B4 und in C2,C3,4 , soll er die Zellen "zusammenfassen" oder besser gesagt die Zellen die "zu viel" sind löschen und in Spalte D alle Inhalte der Zusammengefassten Zeilen mit Komma hintereinander schreiben. Außerdem soll in Zeile E die Anzahl stehen, wie oft zusammengefasst wurde.
Bsp.
A B C D E
1 x y z
1 x y m
1 x y w
1 x d k
Ergebnis:
A B C D E
1 x y z,m,k 3
1 x d k 1
Wenn also nichts zusammengefasst wurde soll das Makro eine 1 in D schreiben.
Hoffe ich konnte mein Problem verständlich darstellen.
Dim lngZeile As Long
Dim varKey As Variant
Dim varEin As Variant
Dim varAus As Variant
Dim varAusgabe As Variant
Dim rngAus As Range
Dim intDict As Object
Dim strDict As Object
Set intDict = CreateObject("Scripting.Dictionary")
Set strDict = CreateObject("Scripting.Dictionary")
varEin = ThisWorkbook.Names("Liste").RefersToRange.Value
Set rngAus = ThisWorkbook.Names("Ausgabe").RefersToRange
'Einlesen
For lngZeile = 1 To UBound(varEin, 1)
varKey = varEin(lngZeile, 1) & ";" & varEin(lngZeile, 2) & ";" & varEin(lngZeile, 3)
If intDict.exists(varKey) Then
strDict(varKey) = strDict(varKey) & "," & varEin(lngZeile, 4)
intDict(varKey) = intDict(varKey) + 1
Else
strDict(varKey) = varEin(lngZeile, 4)
intDict(varKey) = 1
End If
Next lngZeile
'Ausgeben
ReDim varAus(1 To intDict.Count, 1 To 5)
lngZeile = 1
For Each varKey In intDict.keys
varAusgabe = Split(varKey, ";")
varAus(lngZeile, 1) = varAusgabe(0)
varAus(lngZeile, 2) = varAusgabe(1)
varAus(lngZeile, 3) = varAusgabe(2)
varAus(lngZeile, 4) = strDict(varKey)
varAus(lngZeile, 5) = intDict(varKey)
lngZeile = lngZeile + 1
Next varKey
rngAus.Resize(intDict.Count, 5) = varAus
Set intDict = Nothing
Set strDict = Nothing
End Sub
helmut
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Danke ihr zwei, ich glaube der Fehler liegt bei mir, bekomme nämlich bei dem zweiten Code die gleiche Fehlermeldung.
Wenn ich allerdings meine 3000 Zeilen Daten in das Excel Sheet von Helmut packe, funktioniert es, allerdings nur für die ersten 6 Zeilen (habe wie ich gerade feststelle in meinem ersten Post nicht erwähnt, dass die Datei ca. 3600 Zeilen hat :20: ) .
Habe mittlerweile fast alles versucht was das Internet mir so zu dieser Fehlermeldung ausgespuckt hat, leider ohne Erfolg.
Ich benutze Excel 2016 und kopiere einfach euren Code 1 zu 1 in mein Arbeitsblatt. Habe auch versucht ein Extra Modul zu erstellen und dann auszuführen, bzw. einen Button anzulegen, bei welchem der Code hinterlegt ist, aber es kommt trotzdem immer noch die gleiche Fehlermeldung.
Im Anhang hab ich mal einen gekürzten Beispieldatensatz angehängt.
Du bekommst den Code nicht zum Laufen, da Helmut und ich auch im Nachhinein Dich auf entscheidende Vorgaben nicht hingewiesen haben.
Helmut arbeitet mit definierten Namen. Der zu überprüfende Bereich ist als "Liste" benannt und die Ausgabe erfolgt in die benannten Zelle "Ausgabe".
Unten im Code habe ich das geändert.
Aus den Kommentaren wird ersichtlich welcher Bereich dynamisch eingelesen und wohin geschrieben wird.
Folgender Code sollte in Deiner Beispieldatei funktionieren.
Code:
Sub Machs()
Dim lngZeile As Long
Dim varKey As Variant
Dim varEin As Variant
Dim varAus As Variant
Dim strDict As Object
With Sheets("Tabelle1")
lngZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
Set strDict = CreateObject("Scripting.Dictionary")
varEin = Range("A2:D" & lngZeile) 'eingelesener Bereich
Für mich ist die Möglichkeit in Excel an Zellen und Bereichen Namen zu vergeben die wichtigste Funktionalität. Sie macht Formeln und den VBA-code verständlicher. Für Makros gilt die Regel: "Nur über benannte Bereiche auf den Inhalt der Zellen zugreifen."
Und wofür sind Regeln da? Um nachzudenken bevor man sie bricht.
Danke Atilla, aber dein Code spuckt mir die gleiche Fehlermeldung aus und färbt auch mehrere Zeilen rot :/ s.h. Anhang.
Das Makro das ich vorher drüber laufen lasse funktioniert einwandfrei, hier habe ich aber auch fast ausschließlich mit dem Makro Recorder gearbeitet.
![[-]](https://www.clever-excel-forum.de/images/collapse.png)