VBA Nicht Doppelt Kopieren und Anfügen

[Frogger1986]

Hättest du denn eine schickeren Lösungsweg?

[Wastl]

Hättest du denn eine schickeren Lösungsweg?

Erstmal Fragen:
sind die Teilenummern eindeutig?
Von wievielen Daten sprechen wir?

Im Prinzip isses so:
Ich nehme aus der angeknüpften Tabelle eine Teilenummer nach der anderen und prüfe, ob die in 'meine Tabelle' schon ist.
Das sind quasi 2 ineinander geschachtelte Schleifen. Mit 2 weiteren Bedingungen:
is schon da -> exit for
is ned da -> kopier die Zeile rüber bzw. den Inhalt der Zeile.
Das würde genau der Forderung des 1. Posts entsprechen.

Wenn die Datenmenge groß ist wird das langsam, daher mach das alles im Arbeitsspeicher. Lade jeweils ein Tabellenblatt in ein array, und im 3. Array baust du das zusammen und schiebst es hinterher in 'Meine Tabelle'

[Frogger1986]

Die Angeknüpfte Datei hat immer zwischen 800 und 1000 Daten Sätze  im Gesammten könnten es ca 1500 Artikel werden momentan (wächst natürlich)! Die Artikelnummern sind eindeutig dazu! Das ganze sollte recht flott gehen, da das bei jedem Start der Tabelle geprüft werden soll!

[Wastl]

Hi,

wie bekommt 'meine Tabelle' mit wenn Teilenummern aus 'Angeknüpfte Tabelle' verschwinden?

Meine Tabelle ist an eine andere Angeknüpft, aus der ich Daten Aktualisiere. In dieser sind Artikel gelistet, die sobald sie im Bestand sind auftauchen und wenn sie leer sind verschwinden.

Der Aufbau Orignal zu der zueltzt geposteten xlsm ist identisch?
Also die Teilenummer einmal in B und ein andermal in A?

[Wastl]

So,

ein erster Wurf nur mit 2 arrays:

Sub vergleich()
arQuell = Sheets("Angeknüpfte Tabelle").Cells(1, 1).CurrentRegion
arzeil = Sheets("Meine Tabelle").Cells(1, 2).CurrentRegion
For Quell = 2 To UBound(arQuell)
Teilenummer = arQuell(Quell, 1)
i = 0
For Ziel = 2 To UBound(arzeil)
    If Teilenummer = arzeil(Ziel, 2) Then
    i = 1
    Exit For
    End If
Next Ziel
If i = 0 Then
    j = j + 1
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 2) = arQuell(Quell, 1)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 3) = arQuell(Quell, 2)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 4) = arQuell(Quell, 3)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 5) = arQuell(Quell, 4)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 6) = arQuell(Quell, 5)
End If
Next Quell
End Sub

[Frogger1986]

"Meine Tabelle" hat direkte Zellverbindungen zur "Angeknüpften Datei" und die Angeknüpfte Datei Füttere ich durch unser Warenwirtschaftssystem! Ja die Tabellenstruktur ist identisch! In meiner Tabelle sind in Spalte A noch Formeln zum filtern!

[Frogger1986]

Das sieht gut aus, allerdings erkennt er die neu kopierten Datensätze nicht und hört nicht auf zu kopieren! Dessweiteren  sollen nur die Artikelnummer und der Artikel Kopiert werden, KEIN BESTAND!! Das muss dynamisch bleiben! Es wird auch nicht die letzte Leere Zeile erkannt, Sondern immer wieder dort angefangen zu Kopieren wo er zuletzt die Letzte Zahl eingefügt hatte!

[Wastl]

Hi,

bei mir hats in deiner Datei funktioniert, wenn du nicht am Code was geändert hast, tut das auch.

allerdings erkennt er die neu kopierten Datensätze nicht

wie auch? Er fügt sie unterhalb der vorhanden Daten ein. Bei einem Neustart des Makros sind die kopierten Datensätze bereits alt, und werden erkannt. 

Dessweiteren  sollen nur die Artikelnummer und der Artikel Kopiert werden

Dann kommentiere einfach diese 3 Zeilen aus:
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 4) = arQuell(Quell, 3)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 5) = arQuell(Quell, 4)
    Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 6) = arQuell(Quell, 5)

Es wird auch nicht die letzte Leere Zeile erkannt, Sondern immer wieder dort angefangen zu Kopieren wo er zuletzt die Letzte Zahl eingefügt hatte!

Ich fürchte, du hast irgendwas verändert, vielleicht sortierst du zwischen drin?

Code:

For Ziel = 2 To UBound(arzeil)

Hier wird beim Makrosstart die letzte Datenzeile von Ziel ausgelesen und als Schlefenende benutzt und beibehalten bis zum Ende des Makros.
Mit j adiiere ich bei jeder neu gefunden Teilenummer 1 dazu, damit es unterhalb von ubound(arzeil) eingefügt wird.

Code:

Sheets("Meine Tabelle").Cells(UBound(arzeil) + j, 2) = arQuell(Quell, 1)

Wenn also zwischenzeitlich die Reihenfolge - wie in dem von mir geschriebenen Code - nicht verändert wird, passt das.

Am besten, du postest mal den von dir veränderten Code oder eine neue Beispieldatei (mit einem anderen Namen)
Dann können wir gemeinsam guggen, warum das, was bei mir einwandfrei läuft, bei dir zickt.

[Frogger1986]

ok jetzt kopiert der  code nur noch die  ersten beiden Zeilen, jedoch gleicht er nur immer den ersten Bereich  ab und kopiert aufs neue die gleichen Datensätze! ich schick dir die Datei mit dem eingefügten code! Ich habe nichts verändert daran! Lediglich jetzt, den teil,  damit er nur die ersten beiden Zellen kopiert!

[Wastl]

Guten morgen,

ok jetzt kopiert der  code nur noch die  ersten beiden Zeilen

Verwechselst du Spalten mit Zeilen?
Deine neue Datei hat einen Unterschied zur Letzten:
in sheet 'Meine Tabelle' hattest du in der 1. Zeile Überschriften drin, im Bereich A1:F1.
Currentregion hat bei der alten Datei den Bereich A1:F18 ausgewählt, darauf habe ich das Makro aufgebaut und vergleiche die Teilenummer aus 'Angeknüpfte Tabelle' mit der Spalte 2 von sheet 'Meine Tabelle', also mit der Spalte in der die Teilenummern stehen

in der neuen Datei 'Meine Tabelle Mit VBA.xlsm' ist in sheet 'Meine Tabelle' Spalte A vollständig leer.
Currentregion wählt daher den Bereich B1:F9 aus, wenn ich nun die Teilenummer vergleiche bekomme ich in der 2. Spalte des CurrentRegion nur die Bezeichung1, er findet daher keine Übereinstimmung und kopiert immer alles hinüber.

Soviel zu dem Thema, die Beispielmappe muss zwingend den selben Aufbau haben wie das Original!

Wie kannst du das ändern?
Ganz einfach: schreibe in Zelle A1 irgendwas rein bevor du das Makro startest.

Edit:
oder ändere die 2 in eine 1 in dieser CodeZeile:

Code:

If Teilenummer = arzeil(Ziel, 2) Then