Datenabgleich zw. 2 Tabellen

Hallo,

ich übertrage Artikel-Nr aus Tabelle1 ab Zeile 10 in die Tabelle2 ab Zeile 6 mit folgendem Makro:

Private Sub Worksheet_Activate()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Dim y As Long
Dim i As Long
Set Tab1 = ActiveWorkbook.Worksheets(„Tabelle1“)
Set Tab2 = ActiveWorkbook.Worksheets(„Tabelle2“)
i = 10
y = 6
Do Until Tab1.Cells(i, 4) = „“
i = i + 1
Tab2.Cells(y, 3).Value = Tab1.Cells(i, 4).Value
y = y + 1
Loop
End Sub

Da in Tabelle2 ab Zeile 15 Daten stehen, dürfen diese nicht überschrieben werden, d.h. das Makro oben müßte vor dem Schreiben in Tabelle2 jeweils eine neue Zeile einfügen. Der Code: „Tab2.Cells(y, 3).EntireRow.Insert“ fügt immer alle Zeilen aus der Do Until - schleife auf einmal. Das hat den Nachteil, dass auch alte schon übertragene Artikel aus Tab1 erneut eingefügt werden. Es sollen aber nur die hinzugekommenen Artikel eingefügt werden.

Eine zweite Sache ist, dass entfernte Artikel aus Tabelle1 wieder aus Tabelle2 entfernt werden (mit Zeilenlöschung). Weiß jemand wie man diese zwei Sachen in das Makro oben einbaut?

Gruß
Denis

Hallo Denis.

So ganz verstehe ich nicht. Beschreibe das bitte ein bißchen umfangreicher.

Ohne genaueres Beispiel kann ich zwar nicht sagen, ob es sich um einen Fehler handelt, aber mir ist folgendes aufgefallen: Die Anweisung „i = i + 1“ ist meiner Meinug nach an der falschen Stelle im Code. Du fragst in „Do Until…“ ab, ob in Zelle D10 etwas steht, erhöhst danach „i“ um 1 und schreibst dann den Wert aus Zelle D11 in Tabelle2 - Zelle C6, obwohl Du ja noch gar nicht weißt, ob in Zelle D11 etwas drin steht.

i = 10
y = 6
Do Until Tab1.Cells(i, 4) = „“
i = i + 1
Tab2.Cells(y, 3).Value = Tab1.Cells(i, 4).Value
y = y + 1
Loop
End Sub

Soweit erstmal

Viele Grüße
Carsten

So ganz verstehe ich nicht. Beschreibe das bitte ein bißchen
umfangreicher.

Hallo Carsten,
der Code soll folgendes tun: alle Artikel-Nr. aus Tabelle1 ab Zelle D10 sollen in die Tabelle2 ab Zelle C6 übertragen werden. Diese Aufgabe macht der von mir gepostete Code korrekt. Da es sich um ein Ereignismakro handelt, werden die Daten jedesmal beim Anklicken übertragen. Hier kommt es zu ersten Unzulänglichkeiten meines codes, weil die Artikel immer komplett übertragen werden, d.h. auch wenn sie schon in der Tabelle2 aus einer früheren Übertagung drin sind. Meine Frage deshalb: wie baue ich eine Prüfung ein, die die Artikel-Nr. beider Tabellen vergleicht und dann nur die neuen Artikel-Nr. aus der Tabelle1 (Datentabelle) in die Tabelle 2 überträgt. Das Makro muss dazu erkennen, wo es die neuen Artikel einfügen soll. Außerdem müssen Zeilen vor dem Übertragen eingefügt werden, da in der Tabelle2 weiter unter Daten vorhanden sind, die nicht überschrieben werden dürfen. Ich hoffe, dass jetzt alle Unklarheiten beseitigt sind.

Gruß
Denis

Hallo Denis.

Ich hoffe, dass jetzt alle Unklarheiten beseitigt sind.

Sorry, nein.

der Code soll folgendes tun: alle Artikel-Nr. aus Tabelle1 ab
Zelle D10 sollen in die Tabelle2 ab Zelle C6 übertragen
werden. Diese Aufgabe macht der von mir gepostete Code
korrekt.

Soweit klar

Da es sich um ein Ereignismakro handelt, werden die
Daten jedesmal beim Anklicken übertragen.

Soll das denn so sein, oder wäre Dir ein Button für diese spezielle Aufgabe lieber?

Hier kommt es zu
ersten Unzulänglichkeiten meines codes, weil die Artikel immer
komplett übertragen werden, d.h. auch wenn sie schon in der
Tabelle2 aus einer früheren Übertagung drin sind. Meine Frage
deshalb: wie baue ich eine Prüfung ein, die die Artikel-Nr.
beider Tabellen vergleicht und dann nur die neuen Artikel-Nr.
aus der Tabelle1 (Datentabelle) in die Tabelle 2 überträgt.

Ich kenne den genauen Zweck der Übertragung nicht, aber ich behaupte einfach mal pauschal, daß es schneller geht, alle Artikel aus Tabelle1 einfach „drüberzubügeln“, als eine Vergleichsprozedur durchlaufen zu lassen.

Das Makro muss dazu erkennen, wo es die neuen Artikel einfügen
soll.

Geht es hierbei um eine numerische oder alphabetische Sortierung?

Außerdem müssen Zeilen vor dem Übertragen eingefügt
werden, da in der Tabelle2 weiter unter Daten vorhanden sind,
die nicht überschrieben werden dürfen.

Laut Deinem ersten Posting ab Zeile 15. Ist es denn zwingend notwendig, daß die Daten an dieser Stelle stehen oder könnten sie auch in einer anderen Spalte stehen?

Wenn nun in Tabelle1 mehr als neun Artikel-Nr. stehen und deswegen beim Übertragen Zeilen eingefügt werden sollen, müssen dann auch Zeilen gelöscht werden, sofern weniger als neun Artikel übertragen werden sollen?

Wenn Zeilen nun auch gelöscht werden sollen, sollen dann die nicht zu überschreibenden Daten wieder „nach oben geholt“ werden?

Wenn die Daten wieder „nach oben geholt“ werden sollen, sollen sie dann wieder in Zeile 15 beginnen, oder können sie auch direkt unter den übetragenen Artikel-Nr. stehen, selbst wenn das nur vier wären?

Fragen über Fragen.

Das Beste wird sein, Du schickst mal eine Beispiel-Datei.

Der folgende Code fügt schon mal Zeilen ein:

Private Sub Worksheet\_Activate()
 Dim Tab1 As Worksheet
 Dim Tab2 As Worksheet
 Dim y As Long
 Dim i As Long
 Set Tab1 = ActiveWorkbook.Worksheets("Tabelle1")
 Set Tab2 = ActiveWorkbook.Worksheets("Tabelle2")
 i = 10
 y = 6
 Do
 If y \>= 15 Then
 Tab2.Rows(y).EntireRow.Insert
 End If
 Tab2.Cells(y, 3).Value = Tab1.Cells(i, 4).Value
 i = i + 1
 y = y + 1
 Loop While Tab1.Cells(i, 4) ""
End Sub

Soweit erstmal

Viele Grüße
Carsten

Hallo Carsten

Da es sich um ein Ereignismakro handelt, werden die
Daten jedesmal beim Anklicken übertragen.

Soll das denn so sein, oder wäre Dir ein Button für diese
spezielle Aufgabe lieber?

Das Ereignis Activate wäre mir lieber.

Ich kenne den genauen Zweck der Übertragung nicht, aber ich
behaupte einfach mal pauschal, daß es schneller geht, alle
Artikel aus Tabelle1 einfach „drüberzubügeln“, als eine
Vergleichsprozedur durchlaufen zu lassen.

Bei einem Ereignismakro geht das nicht, weil dann bei jedem Anklicken der Tabelle alle Artikel aus Tabelle1 (Stammdaten) kopiert werden und ich die Daten dann mehrfach habe. Zum Zweck der Übertragung: ich brauche die Artikkel-Nr. damit in der Tabelle 2 die Einnahmen pro Artikel ermittelt werden können. Die Formeln dazu habe ich schon. Ich denke um die Prüfung der Artikel komme ich nicht herum, so dass immer nur neu angelegte Artikel aus Tabelle 1 übertragen werden. Was hälst du von diesem Code für diese Aufgabe
If
Tab2.Cells(y, 3).Value Tab1.Cells(i, 4).Value Then
Tab2.Cells(y, 3).Value = Tab1.Cells(i, 4).Value
End If

Das Makro muss dazu erkennen, wo es die neuen Artikel einfügen
soll.

Geht es hierbei um eine numerische oder alphabetische
Sortierung?

Die zu übertragenden Artikel sind nummerisch, müssen aber nicht sortiert werden. Das wichtige ist, dass das Makro erkennt in welcher Zeile der Spalte 3 die neuen Artikel aus Tabelle 1 eingefügt werden sollen.

Laut Deinem ersten Posting ab Zeile 15. Ist es denn zwingend
notwendig, daß die Daten an dieser Stelle stehen oder könnten
sie auch in einer anderen Spalte stehen?

Die Spalte 3 ist zwingend einzuhalten.

Wenn nun in Tabelle1 mehr als neun Artikel-Nr. stehen und
deswegen beim Übertragen Zeilen eingefügt werden sollen,
müssen dann auch Zeilen gelöscht werden, sofern weniger als
neun Artikel übertragen werden sollen?

Die Tabelle1 (maßgebende Tabelle) und Tabelle2 müssen immer die selben Artikel haben (Datensynchronisation), d.h. wenn aus Tabelle1 Artikel entfernt werden, dann muss in der Tabelle2 die Zeile mit diesem Artikel, die aus einer früheren Übertragung stammt, wieder gelöscht werden.

Wenn Zeilen nun auch gelöscht werden sollen, sollen dann die
nicht zu überschreibenden Daten wieder „nach oben geholt“
werden?

Wenn komplette Zeilen gelöscht werden, springen die Daten von unten automatisch nach oben. Für diese Aufgabe ist somit kein eigener Code erforderlich.

Das Beste wird sein, Du schickst mal eine Beispiel-Datei.

Wenn nach diesem Beitrag immer noch nicht klar ist, was ich meine, komme ich dem nach.

Der folgende Code fügt schon mal Zeilen ein:

Private Sub
Worksheet_Activate()
Dim Tab1 As Worksheet
Dim Tab2 As Worksheet
Dim y As Long
Dim i As Long
Set Tab1 = ActiveWorkbook.Worksheets(„Tabelle1“)
Set Tab2 = ActiveWorkbook.Worksheets(„Tabelle2“)
i = 10
y = 6
Do
If y >= 15 Then
Tab2.Rows(y).EntireRow.Insert
End If
Tab2.Cells(y, 3).Value = Tab1.Cells(i, 4).Value
i = i + 1
y = y + 1
Loop While Tab1.Cells(i, 4) „“
End Sub

Soweit erstmal

Der Code funktioniert so weit, dass Daten korrekt übertragen werden und auch die richtige Anzahl von Zeilen eingefügt wird. Leider werden bei jedem Anklicken der Tabelle2 Daten übertragen, obwohl sie schon aus einer früheren Übertagung da sind, d.h. hier muss noch code her, der vor der übertragung in Tabelle1 nachschaut, ob dort Artikel-Nr. drin sind, die nicht in Tabelle2 da sind. Nur dies sollen übertragen werden. Falls keine neuen Artikel da sind, soll gar nichts übertragen werden.

Gruß
Denis

Hallo Denis.

Ich habe mal ein bißchen geschrieben. Weil ich aber morgen sehr früh aufstehen muß, werd’ ich jetzt erst mal Schluß machen und sportlich in die Heia gehen.

hier schon mal ein paar Code-Fragmente:

Option Explicit
 
Private Const Col1 As Long = 4
Private Const Col2 As Long = 3

Private Tab1\_AnzahlArtikel As Long
Private Tab2\_AnzahlArtikel As Long
Private Tab2\_DatenInZeile As Long
Private Row1 As Long
Private Row2 As Long
 
Private Tab1 As Worksheet
Private Tab2 As Worksheet
 
Private Sub Worksheet\_Activate()
 Set Tab1 = ActiveWorkbook.Worksheets("Tabelle1")
 Set Tab2 = ActiveWorkbook.Worksheets("Tabelle2")
 Row1 = 10
 Row2 = 6
 Zaehle\_Artikel\_Tab1
 Suche\_Daten\_Tab2
 If (Tab1\_AnzahlArtikel = 0) Then Loesche\_Artikel
 If (Tab1\_AnzahlArtikel \> 0) And (Tab2\_AnzahlArtikel = 0) Then Uebertrage\_Artikel
 If (Tab1\_AnzahlArtikel \> 0) And (Tab2\_DatenInZeile \> 0) Then Vergleiche\_Artikel
End Sub
 
Private Sub Zaehle\_Artikel\_Tab1()
 Dim x As Long
 x = Row1
 Do While Tab1.Cells(x, Col1) ""
 x = x + 1
 Loop
 Tab1\_AnzahlArtikel = x - Row1
End Sub
 
Private Sub Suche\_Daten\_Tab2()
 Dim x As Long
 x = Row2
 Do While Tab2.Cells(x, Col2) "bla" 'Hier muß der Wert der 1. Zelle hin, der die nicht zu überschreibenden Daten enthält
 x = x + 1
 Loop
 Tab2\_DatenInZeile = x - Row2
 For x = Row2 To (Row2 + Tab2\_DatenInZeile - 1)
 If Tab2.Cells(x, Col2) "" Then Tab2\_AnzahlArtikel = Tab2\_AnzahlArtikel + 1
 Next
End Sub
 
Private Sub Loesche\_Artikel()
 Dim x2 As Long
 For x2 = (Row2 + Tab2\_DatenInZeile - 1) To Row2 Step -1
 If x2 \>= 15 Then
 Tab2.Rows(x2).EntireRow.Delete
 Else
 Tab2.Cells(x2, Col2).Clear
 End If
 Next
End Sub
 
Private Sub Uebertrage\_Artikel()
 Dim x1 As Long
 Dim x2 As Long
 x2 = Row2
 For x1 = Row1 To (Row1 + Tab1\_AnzahlArtikel - 1)
 If x2 \>= 15 Then
 Tab2.Rows(x2).EntireRow.Insert
 End If
 Tab2.Cells(x2, Col2) = Tab1.Cells(x1, Col1)
 x2 = x2 + 1
 Next
End Sub
 
Private Sub Vergleiche\_Artikel()
 Dim x1 As Long
 Dim x2 As Long
 For x1 = Row1 To (Row1 + Tab1\_AnzahlArtikel - 1)
 For x2 = Row2 To (Row2 + Tab2\_DatenInZeile - 1)
 If Tab1.Cells(x1, Col1) Tab2.Cells(x2, Col2) Then

 End If
 Next
 Next
End Sub

Die Vergleichsprozedur ist noch nicht fertig. Das andere kannst Du ja mal ausprobieren. Vielleicht ist es ja schon das, was Du suchst.

Viele Grüße
Carsten

Hallo Carsten,

du meine Güte, du hast dich richtig ins Zeug gelegt. Danke für die Mühe, ich werde Deinen Code später testen, weil ich mittlerweile mit meinem Code weit fortgeschritten bin. War harte Arbeit, obwohl die Grundcodierung aus dem Internet abgekupfert wurde. Hier ist der Code, der auch den Vergleich beinhaltet:

Private Sub Worksheet_Activate()
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer

z = 10 ’ Schleifenzähler auf Startwert (Zeile 1)
Do While Sheets(„Stammdaten“).Cells(z, 6) „“ ’ Start der Schleife zum Einlesen der Werte
verg1(z) = Sheets(„Stammdaten“).Cells(z, 6) ’ 1. Vergleichswert einlesen
z = z + 1
Loop
y = 6
Do While Sheets(„Gewinn“).Cells(y, 3) „“
verg2(y) = Sheets(„Gewinn“).Cells(y, 3) ’ 2. Vergleichswert einlesen
z = z + 1
y = y + 1
Loop
For r = 1 To z
For s = 1 To y
If verg1® = verg2(s) Then merk1® = „ja“ ’ Wenn Vergleichswerte gleich, Merker setzen
Next s
Next r
tt = 6
Do While Sheets(„Gewinn“).Cells(tt, 3) „“
tt = tt + 1
Loop
For t = 1 To r
If merk1(t) „ja“ Then ’ Wenn Merker = „ja“ dann
Rows(tt - 1).Copy
Rows(tt).Insert shift:=xlDown
Application.CutCopyMode = False
Sheets(„Gewinn“).Cells(tt, 3) = verg1(t)
tt = tt + 1
End If
Next t
Range(„F5“).Select
End Sub

Eine Sache muss ich noch ausräumen. In der Tabelle „Gewinn“ wird immer eine Zeile eingefügt, auch wenn die Artikel in den beiden Tabellen identisch sind. Die Bedingung (If merk1(t) „ja“ Then) müßte nur ausgeführt werden, wenn die Prüfung ergibt (If verg1® = verg2(s) Then merk1® = „ja“), dass es keine Duplikate gibt. Hast du eine Erklärung dafür, warum trotzdem immer eine Zeile eingefügt wird?

Gruß
Denis

Hallo Denis.

Hast du eine Erklärung dafür,
warum trotzdem immer eine Zeile eingefügt wird?

Auf die Schnelle sind mir jetzt nur diese Sachen hier aufgefallen:

Do While Sheets(„Stammdaten“).Cells(z, 6 ) „“

Ist es korrekt, daß die Stammdaten in Spalte F stehen?

Do While Sheets(„Gewinn“).Cells(y, 3) „“
verg2(y) = Sheets(„Gewinn“).Cells(y, 3) ’ 2.
Vergleichswert einlesen
z = z + 1
y = y + 1
Loop

Soll z auch in dieser Schleife weiter hochgezählt werden?

If merk1(t) „ja“ Then

Im Kommentar hinter dieser Abfrage hast Du „=“ geschrieben, nicht ungleich.

Ich habe den Code noch nicht ausprobiert, aber vielleicht liegt ja hier irgendwo schon die Ursache dafür.

Soweit erstmal. Ich werde den Code noch ausprobieren.

Viele Grüße
Carsten

Hallo Carsten,

Ist es korrekt, daß die Stammdaten in Spalte F stehen?

ja

Do While Sheets(„Gewinn“).Cells(y, 3) „“
verg2(y) = Sheets(„Gewinn“).Cells(y, 3) ’ 2.
Vergleichswert einlesen
z = z + 1
y = y + 1
Loop

Soll z auch in dieser Schleife weiter hochgezählt werden?

ja

If merk1(t) „ja“ Then

Im Kommentar hinter dieser Abfrage hast Du „=“ geschrieben,
nicht ungleich.

ungleich ist richtig, im Kommentar ist es falsch genannt

Ich habe den Code noch nicht ausprobiert, aber vielleicht
liegt ja hier irgendwo schon die Ursache dafür.

wegen der Zeile mußt du dich nicht bemühen. Ich habs herausgefunden, auch wenn ich es nicht komplett verstehe. Hinter das r muß -1 hin, dann gibts auch keine unnötigen Zeileneinfügungen :wink:
For t = 1 To r - 1
If merk1(t) „ja“ Then

Soweit erstmal. Ich werde den Code noch ausprobieren.

Funktioniert tadellos. Eine allerletzte Sache fehlt noch mit der ich heute erfolglos gekämpft habe. Die Zeilenlöschung in der Tabelle Gewinn, wenn bei Stammdaten ein Artikel entfernt wird. Kriege das Makro einfach nicht auf die überflüssige Artikel-Nr. um die Zeile mit „Rows(tt).Delete“ löschen zu können.

Gruß
Denis