Aus 2 Tabellen eine machen

[Rabe]

Hi,

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ß.

[Kl@us-M.]

Die ursprünglich hier stattgefundene Diskussion übers Alter / Geburtsjahrgänge habe ich in den Clever-Treff -》Plaudern verschoben ...

[beefjerckey]

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?

[WillWissen]

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.

[Steffl]

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

[beefjerckey]

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

[Steffl]

Hallo Axel,

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

[beefjerckey]

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

[Steffl]

Hallo Axel,

diese Bedingung hatte ich doch schon im letzten geposteten Code eingebaut. Hast Du den nicht getestet?