Hi,
(21.05.2014, 09:39)beefjerckey schrieb: [ -> ]Ich habe die Datei jetzt mal hier angehängt, mal sehen ob das klappt.
anscheinend hat es geklappt und die Datei ist auch nicht sehr groß.
Die ursprünglich hier stattgefundene Diskussion übers Alter / Geburtsjahrgänge habe ich in den Clever-Treff -》Plaudern verschoben ...
Hallo nochmals,
kann mir denn keiner helfen?
Hier nochmals was ich möchte:
' Auswertung: "Neue Daten" ohne die, die in "Alte Daten" enthalten sind.
' Tabelle "Neue Daten": Wenn Zeile 5 nicht enthalten in beliebiger Zeile "Alte Daten", dann
' Kopiere Zeile 5 nach "Auswertung".
' Tabelle "Neue Daten": Wenn Zeile 5 enthalten in beliebiger Zeile "Alte Daten", dann
' mache nichts
' Mache das mit allen befüllten Zeilen der Tabelle "Neue Daten"
Erbarmt sich mir bitte jemand?
(22.05.2014, 09:16)beefjerckey schrieb: [ -> ]Hier nochmals was ich möchte:
' Auswertung: "Neue Daten" ohne die, die in "Alte Daten" enthalten sind.
' Tabelle "Neue Daten": Wenn Zeile 5 nicht enthalten in beliebiger Zeile "Alte Daten", dann
' Kopiere Zeile 5 nach "Auswertung".
' Tabelle "Neue Daten": Wenn Zeile 5 enthalten in beliebiger Zeile "Alte Daten", dann
' mache nichts
' Mache das mit allen befüllten Zeilen der Tabelle "Neue Daten"
Hi,
unabhängig davon, dass ich dir mit VBA leider nicht helfen kann, ist deine Aufgabenstellung für mich (und eventuell auch für potentielle Helfer) nicht so ganz verständlich.
Nach welchen Kriterien sollen denn die Daten verglichen werden? So wie ich das sehe, passt deine Musterauswertung nicht zu den vorhandenen Daten.
Hallo,
teste mal
Code:
Sub prcAuswertung()
Dim objDic As Object
Dim lngZeile As Long, lngC As Long
Dim varkey As Variant
lngC = 5
Set objDic = CreateObject("scripting.dictionary")
With Worksheets("Alte Daten")
For lngZeile = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
'die Zeile zu einer Kette zusammenfügen
varkey = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 2).Resize(, 17))), "::")
'und in ein Dictionary einladen
objDic(varkey) = objDic(varkey) + 1
Next lngZeile
End With
With Worksheets("Neue Daten")
For lngZeile = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
'die Zeile zu einer Kette zusammenfügen
varkey = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 2).Resize(, 17))), "::")
'prüfen, ob diese Kette im Dictionary enthalten ist
If Not objDic.exists(varkey) Then
'wenn nein, diese Zeile in die Tabelle Auswertung kopieren
.Cells(lngZeile, 2).Resize(, 17).Copy Worksheets("Auswertung").Cells(lngC, 2)
lngC = lngC + 1
End If
Next lngZeile
End With
Set objDic = Nothing
End Sub
Das ist der Hit.
Mit so wenig Code, ich bin mehr als begeistert!
Ist genau was ich wollte. Danke, danke, danke!
Jetzt ist mir noch etwas aufgefallen:
Ist es ggf. möglich eine Spalte (z.Bspl. "C") zu "ignorieren"? Dauerhaft.
Oder müsste die dann vorher gelöscht werden?
Ich bin total begeistert.
Gruß Axel
Hallo Axel,
(23.05.2014, 07:30)beefjerckey schrieb: [ -> ]Ist es ggf. möglich eine Spalte (z.Bspl. "C") zu "ignorieren"? Dauerhaft.
Oder müsste die dann vorher gelöscht werden?
Soll die Spalte bei der Überprüfung weggelassen werden? Oder beim Eintragen in die Tabelle Auswertung? Kommen da eventuell noch weitere Spalten wo weggelassen werden müssen? Habe mal ein paar Zeilen neu eingefügt und dafür andere auskommentiert. Teste mal und gebe Bescheid.
Code:
Sub prcAuswertung()
Dim objDic As Object
Dim lngZeile As Long, lngC As Long
Dim varkey As Variant
Dim arWert As Variant
lngC = 5
Set objDic = CreateObject("scripting.dictionary")
With Worksheets("Alte Daten")
For lngZeile = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
'die Zeile zu einer Kette zusammenfügen
' varkey = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 2).Resize(, 17))), "::")
varkey = .Cells(lngZeile, 2) & "::" & Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 4).Resize(, 15))), "::")
'und in ein Dictionary einladen
objDic(varkey) = objDic(varkey) + 1
Next lngZeile
End With
With Worksheets("Neue Daten")
For lngZeile = 5 To .Cells(.Rows.Count, 2).End(xlUp).Row
'die Zeile zu einer Kette zusammenfügen
' varkey = Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 2).Resize(, 17))), "::")
varkey = .Cells(lngZeile, 2) & "::" & Join(WorksheetFunction.Transpose(WorksheetFunction.Transpose(.Cells(lngZeile, 4).Resize(, 15))), "::")
'prüfen, ob diese Kette im Dictionary enthalten ist
If Not objDic.exists(varkey) Then
'wenn nein, diese Zeile in die Tabelle Auswertung kopieren
' .Cells(lngZeile, 2).Resize(, 17).Copy Worksheets("Auswertung").Cells(lngC, 2)
'die Variable an den :: aufsplitten
arWert = Split(varkey, "::")
'und in die Tabelle einfügen
Worksheets("Auswertung").Cells(lngC, 2).Resize(, UBound(arWert) + 1) = arWert
lngC = lngC + 1
End If
Next lngZeile
End With
Set objDic = Nothing
End Sub
Hallo,
also ideal wäre es die Spalte "C" (Protokollzeit) zu ignorieren, also beim Vergleich der Zeile nicht zu beachten.
Aber das wird wohl nicht funktionieren, oder?
Gruß Axel
Hallo Axel,
diese Bedingung hatte ich doch schon im letzten geposteten Code eingebaut. Hast Du den nicht getestet?