Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1212to1216
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Kopieren von Daten in andere Mappe, ohne Duplikate

Kopieren von Daten in andere Mappe, ohne Duplikate
Daten
Hallo,
folgende Beispieltabellen (Tabellen haben gleiche Struktur und gehen bis Spalte BP - ich habe hier nur einen Ausschnitt):
Zieltabelle (Sammeltabelle):
Workflow_GSZ_2011
 ABCDEFGHIJKL
1ZählerGSZ-Ketten NrGSZ NameViFlowStatus_MasterlisteAktivierungsdatum
(JJJJMMTT)
LandErstellerDeaktivierungsdatumBemerkungenAT (1 = AT getestet)Relevant für FI (0 = nein, 1 = ja)
2xGSZ_0000_K000DE_Standardauftrag WE bei RG-Prüfung vorhanden_V1_mvi      DEmvi      1
3xGSZ_0000_K001DE_Standardauftrag WE nach RG-Eingang_V1_mvi      DEmvi      1
4xGSZ_0006_K005DE_Lagerübergreifende Aufträge_V1_jmo      DEjmo      1
5xGSZ_0022_K001DE_Auftrag mit Minuserlös_V1_ada      DEada      1
6xGSZ_0022_K002DE_Minuserlös bei Auftragseingabe_V1_ada      DEada      1
7xGSZ_0028_K001DE_mehrere Aufträge in einer Lieferung_V1_ada      DEada      1
8xGSZ_0028_K002DE_Auftrag mit Einteilung_V1_ada      DEada      1
9xGSZ_0029_K001DE_Auftragsstorno_V1_rhs      DErhs      1
10xGSZ_0029_K002DE_Auftragsstorno Rückstände_V1_ada      DEada      0
11xGSZ_0029_K003DE_Auftragsstorno bei vorhandenen Folgebelegen_V1_rgn      DErgn      1
12xGSZ_0030_K004DE_Überzählige_Ware_einbuchen_V1_rgn      DErgn      1
13xGSZ_0030_K005DE_Überzählige_Ware_Reklamation_NL_V1_sst      DEsst      0
14xGSZ_0030_K006DE_Überzählige_Ware_Reklamation_Gutschrift_V1_sst      DEsst      1
15xGSZ_0030_K008DE_Mitarbeitbarverkauf_V1_ada      DEada      1
16xGSZ_0030_K009DE_Mitarbeitbarverkauf_V1_ada      DEada      1
17xGSZ_0049_K003DE_Reklamation_m._ÜZ_Lagerplatz_m._NL_V1_ada      DEada      1
18xGSZ_0049_K004DE_Reklamation_m._ÜZ_Lagerplatz_o._NL_V1_sst      DEsst      1
19xGSZ_0049_K005DE_Reklamation_o._ÜZ_m._NL_V1_sst      DEsst      1
20xGSZ_0049_K006BE_Rack Jobbing_V1_rhs      BErhs      1
21xGSZ_0049_K007DE_Rack Jobbing_V1_rhs      DErhs      1
22xGSZ_0087_K002IT_Rack Jobbing_V1_rhs      ITrhs      1
23xGSZ_0087_K002NL_Rack Jobbing_V1_rhs      NLrhs      1
24xGSZ_0087_K003DE_Rack Jobbing_V1_rhs      DErhs      1
25xGSZ_0049_K003BE_Standardauftrag für Mitarbeiter_V1_lka      BElka      1
26xGSZ_0049_K005DE_Eigenverbrauch für EP.Abteilungen-V1_rhs      DErhs      1
27xGSZ_0152_K001DE_Standardauftrag MediMax_ohne Organschaft_V1_mre      DEmre      1
28xGSZ_0152_K002DE_Standardauftrga MediMax mit Organschaft_V1_mre      DEmre      1
29xGSZ_0049_K004DE_Standardauftrag für Mitarbeiter_V1_mvi      DEmvi      1
30xGSZ_0018_K006DE_Auftrag für ein Mitglied_ aufgrund virtuelles Lager_V1_mvi      DEmvi      1
31xGSZ_0018_K007DE_Auftrag_für_ein_Mitglied_Barzahler_aufgrund_virtuelles_Lager_V1_mvi      DEmvi      1
32xGSZ_0414_K001DE_Blitzauftrag_unpassende_Aktualität_V1_mso      DEmso      1
33xGSZ_0414_K004IN_Blitzauftrag_internationaler_Artikel_Mindererlös_unterschritten_V1_mso      INmso      1
34xGSZ_0414_K005DE_Blitzauftrag_Aktionsartikel_Mindestabnahmemenge_unterschritten_V1_mvi      DEmvi      1

Tabellendarstellung in Foren Version 5.39


Quelltabelle (mehrere Tabellen mit einzelnen Themen):
Workflow_GSZ_Aktionen
 ABCDEFGHIJKL
1ZählerGSZ-Ketten NrGSZ NameViFlowStatus_MasterlisteAktivierungsdatum
(JJJJMMTT)
LandErstellerDeaktivierungsdatumBemerkungenAT (1 = AT getestet)Relevant für FI (0 = nein, 1 = ja)
2xGSZ_0000_K001DE_Standardauftrag WE nach RG-Eingang_V1_mvi      DEmvi      1
3xGSZ_0000_K001BE_Standardauftrag WE nach RG-Eingang_V1_mvi      DEmvi      1
4xGSZ_0003_K002DE_Alternativartikel und mehrere Bestellpositionen_V1_ada      DEada      1
5xGSZ_0003_K003AT_Ersatzartikel und mehrere Bestellpositionen_V1_ada      DEada      1
6xGSZ_0003_K003NL_Ersatzartikel und mehrere Bestellpositionen_V1_ada      DEshe      1
7xGSZ_0003_K005DE_Ersatzartikel mit einer Bestellposition_V1_ada      DEada      1
8xGSZ_0003_K006DE_Natural und Crossselling im EK_V1_rgn      DErgn      1

Tabellendarstellung in Foren Version 5.39


dazu habe ich folgenden Code in der Quelltabelle:
Private Sub CommandButton1_Click()
Dim wksQuelle As Worksheet
Dim rngRow As Range, rngSelektion As Range
Dim wbSammler As Workbook, wksSammler As Worksheet, rngZelle As Range
Dim vKey As Variant, lZeile As Long
'Spalte mit eindeutgem Schlüssel = Spalte B
Const SpalteKey As Long = 2
'Dateiname der Sammeldatei                                    -  anpassen !
Const sNameSammler As String = "\\\\Malibu\Projekte\SAP\300_Test\2011\110_Verwaltung\ _
20_Auswertungen\Workflow_GSZ_2011.xlsm"
'Blattname oder Nr des Tabellenblatts in Sammeldatei      - ggf. anpassen !
Const vBlattSammler = 1
On Error GoTo Fehler
'Quellblatt und Zell-Selektion Objekt-Variablen zuweisen
Set wksQuelle = ActiveSheet
Set rngSelektion = Selection
'1. Zeile des selektierten Bereichs prüfen
If rngSelektion.Row  Sammeldatei") = vbNo Then GoTo Beenden
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Sammeldatei öffnen
Set wbSammler = Workbooks.Open(Filename:=sNameSammler, Ignorereadonlyrecommended:=True)
Set wksSammler = wbSammler.Worksheets(vBlattSammler)
'Keys der Selektion in Sammeldatei suchen und Zeilen kopieren
For Each rngRow In rngSelektion.Rows
vKey = wksQuelle.Cells(rngRow.Row, SpalteKey).Value
Set rngZelle = wksSammler.Columns(SpalteKey).Find(What:=vKey, LookIn:=xlValues, _
lookat:=xlWhole)
With wksSammler
If rngZelle Is Nothing Then
'Neuer Schlüssel
lZeile = .Cells(.Rows.Count, SpalteKey).End(xlUp).Row + 1
Else
'vorhandener Schlüssel
lZeile = rngZelle.Row
End If
End With
wksQuelle.Rows(rngRow.Row).Copy Destination:=wksSammler.Rows(lZeile)
Next
wbSammler.Close savechanges:=True
Beenden:
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Der Code leistet folgendes:
Von der Quelltabelle (die dynamisch also fortwährend befüllt wird) werden Zeilen in die Zieltabelle kopiert und zwar folgendermaßen:
In der Zieltabelle werden die zu kopierenden Zeilen markiert. Danach wird auf einen Button geklickt. Jetzt wird
1. die Zieltabelle im Hintergrund geöffnet
2. geprüft, ob Daten in Spalte B ("GSZ-Name") schon vorhanden sind
3. Zeile wird in Zieltabelle übertragen, falls Daten in Spalte B noch nicht vorhanden;
Zeile wird in Zieltabelle nicht übertragen, falls Daten in Spalte B schon vorhanden bzw. Zeile wird
dann überschrieben (sodaß in Spalte B keine doppelten Einträge vorhanden sind)
4. Zieltabelle wird im Hintergrund gespeichert und geschlossen
Soweit funktioniert der Code auch. Jetzt ist aber folgendes Problem:
Tabelle1
 ABC
1Zähler GSZ-Ketten Nr GSZ Name
2x GSZ_0000_K001 DE_Standardauftrag WE nach RG-Eingang_V1_mvi
3x GSZ_0000_K001 BE_Standardauftrag WE nach RG-Eingang_V1_mvi
4x GSZ_0003_K002 DE_Alternativartikel und mehrere Bestellpositionen_V1_ada
5x GSZ_0003_K003 AT_Ersatzartikel und mehrere Bestellpositionen_V1_ada

Tabellendarstellung in Foren Version 5.39


Kriterium für doppelte sollte nicht nur die Spalte B ("GSZ-Ketten Nr") sein, sondern auch die ersten beiden
Zeichen (Länderkennzeichen) der Spalte C ("GSZ-Name"). Z. Bsp. sind oben die Einträge in Zeile 2 und 3 keine Duplikate, da die Länderkennzeichen unterschiedlich sind ("DE" und "BE"). D. h. es müßte zusätzlich zur Überprüfung, ob identische Daten in Spalte B stehen noch überprüft werden, ob, wenn dieses der Fall ist auch die ersten beiden Zeichen in Spalte C identisch sind.
Kann man vorstehenden Quellcode entsprechend ändern?
Ich hoffe ich habe das Problem verständlich geschildert.
Viele Grüße
Stefan

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Benutzer
Anzeige
AW: Kopieren von Daten in andere Mappe, ohne Duplikate
17.05.2011 12:45:53
Daten
Hallo,
teste mal:
Private Sub CommandButton1_Click()
Dim wksQuelle As Worksheet
Dim rngRow As Range, rngSelektion As Range
Dim wbSammler As Workbook, wksSammler As Worksheet
Dim vKey As Variant, lZeile As Long
Dim ObjKeys As Object, rngKey As Range
Set ObjKeys = CreateObject("Scripting.Dictionary")
'Spalte mit eindeutgem Schlüssel = Spalte B
Const SpalteKey As Long = 2
'Dateiname der Sammeldatei                                    -  anpassen !
Const sNameSammler As String = "\\\\Malibu\Projekte\SAP\300_Test\2011\110_Verwaltung\ _
20_Auswertungen\Workflow_GSZ_2011.xlsm"
'Blattname oder Nr des Tabellenblatts in Sammeldatei      - ggf. anpassen !
Const vBlattSammler = 1
On Error GoTo Fehler
'Quellblatt und Zell-Selektion Objekt-Variablen zuweisen
Set wksQuelle = ActiveSheet
Set rngSelektion = Selection
'1. Zeile des selektierten Bereichs prüfen
If rngSelektion.Row  Sammeldatei") = vbNo Then GoTo Beenden
'Bildschirmaktualisierung und Ereignismakros deaktivieren
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
'Sammeldatei öffnen
Set wbSammler = Workbooks.Open(Filename:=sNameSammler, Ignorereadonlyrecommended:=True)
Set wksSammler = wbSammler.Worksheets(vBlattSammler)
'Schlüssel sammeln
With wksSammler
For Each rngKey In .Range(.Cells(2, 2), .Cells(Rows.Count, 2).End(xlUp))
ObjKeys(rngKey.Value & Left(rngKey.Offset(, 1), 2)) = rngKey.Row
Next rngKey
End With
'Keys der Selektion in Sammeldatei suchen und Zeilen kopieren
For Each rngRow In rngSelektion.Rows
vKey = wksQuelle.Cells(rngRow.Row, SpalteKey) _
& Left(wksQuelle.Cells(rngRow.Row, SpalteKey).Offset(, 1), 2)
With wksSammler
If ObjKeys.exists(vKey) Then
'vorh. Schlüssel
lZeile = ObjKeys(vKey)
Else
'neuer Schlüssel
lZeile = .Cells(.Rows.Count, SpalteKey).End(xlUp).Row + 1
End If
End With
wksQuelle.Rows(rngRow.Row).Copy Destination:=wksSammler.Rows(lZeile)
Next
wbSammler.Close savechanges:=True
Beenden:
Fehler:
With Err
Select Case .Number
Case 0 'alles ok
Case Else
MsgBox "Fehler-Nr.: " & .Number & vbLf & .Description
End Select
End With
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub

Gruß
Rudi
Anzeige
AW: Kopieren von Daten in andere Mappe, ohne Duplikate
17.05.2011 13:25:53
Daten
Hallo Rudi,
ich habs getestet und funktioniert.
Vielen Dank. Du hast mir damit sehr geholfen.
Viele Grüße
Stefan

304 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige