Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Datenaustausch zwischen zwei Tabellenblättern

Datenaustausch zwischen zwei Tabellenblättern
25.01.2017 16:26:57
Gregy
Hallo liebe Experten,
ich hoffe, mein Problem verständlich schildern zu können.
Aus einer Tabelle (ein Protokoll) wo in Spalte C eine deklaration in Form von A für Aufgabe, B für Beschluss und I für Information steht filtere ich alle Zeilen auf der Suche nach A und schreibe die komplette Zeile, in der in Spalte C eine A zu finden ist untereinander weg in ein weiteres Tabellenblatt.
Dies realisiere ich auf knopfdruck (Button/Schaltfläche) mit folgendem Skript:
With Tabelle1
ZeileMax = .UsedRange.Rows.Count
n = 2
For Zeile = 15 To ZeileMax
'If .Cells(Zeile, 3).Value = "A" And Not IsDate(Cells(Zeile, 7))
If .Cells(Zeile, 3).Value = "A" Then
.Rows(Zeile).Copy Destination:=Tabelle4.Rows(n)
n = n + 1
End If
Next Zeile

Da es sich wie gesagt um ein Protokoll handelt, muss in der exportierten Tabelle in Spalte G ein umsetzungsdatum eingetragen werden.
Mein Ziel ist es, dass ich bevor ich das obere Skript ausführe, die zweite Tabelle Zeile für Zeile durchsucht wird, und sofern sich in einer Zeile in Spalte G ein A findet, soll dieses Datum in Tabelle 1 in die korekkte Spalte geschrieben werden.
Da ich nun den bisherigen Tag erfolglos damit verbracht habe eine Lösung zu finden und ich ehrlich gesagt keine Idee habe, was ich in google eingeben soll freue ich mich üner jede Hilfe.
Vielen Dank im Voraus!
MfG
Gregy

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 13:53:39
fcs
Hallo Gregy,
damit du aus der 2. Tabelle (=Tabelle in die die vorher einmal die noch nicht umgesetzen/erledigten Aufgaben kopiert hast) die umgesetzten/erledigten Aufgaben in die Ursprungs-Tabelle (=1. Tabelle)
kopieren kannst müssen die Einträge im Protokoll eindeutig identifizierbar sein.
Entweder ein Wert (ID oder laufende Nr.) in einer Spalte oder indem man die Wee aus mehreren Spalten zu einem eindeutigen Wert für jede Zeile zusammenfügt.
Anhängig davon was bei dir vorhanden/möglich ist gibt es unterschiedliche Ansätze, um die Datenzeilen zu suchen.
Ist eine ID je Protokollzeile vorhanden dann kann man der Funktion "Suchen" (Find unter VBA ) arbeiten oder der Funktion VERGLEICH (LookUp unter VBA), um die Zeile mit der ID aus 2. Tabelle in 1. Tabelle zu finden.
Müssen Werte aus mehreren Spalten zusammengefügt werden, um den Datensatz eindeutig zu kennzeichen, dann muss mann die Werte in der Zeile in 2.Tabelle in einer Variablen zuammenfügen inkl. Trennzeichen.
z.B:
Sub Test
Dim wks1 as Worksheet, wks2 as Worksheet
Dim Zeile1 as Long, Zeile2 as Long, Zeile1_L as Long
Dim arrKeys() as String, strSuch as String
Set wks1 = WorkBooks("Protokoll-Datei.xlsm").Worksheets(1)
Set wks2 =  WorkBooks("Export-Datei.xlsx").Worksheets(1)
'Schluesselwerte aus Tabelle1 in Array speichern
With wks1
Zeile1_L = .Cells(.Rows.Count, 3).End(xlup).Row
Redim arrKeys(15 to Zeile1_L)
For Zeile1 = LBound(arrKeys) to Zeile1_L
'Werte aus Spalten A und D zu Schlüsselwert zusammenfügen
strSuch = .Cells(Zeile1, 1).Text & "|" & .cells(Zeile1, 4).Text
arrKeys(Zeile1)=strSuch
Next
End With
'Zeilen in Tabelle1 abarbeiten
With wks2
For Zeile2 = 2 to .Cells(.Rows.Count, 3).End(xlup).Row
'Prüfen, ob Erledigt-Datum in 2. Tabelle eingetragen ist
If .Cells(Zeile2, 7).Value  "" Then
'Werte aus Spalten A und D zu Schlüsselwert/Suchbegriff zusammenfügen
strSuch = .Cells(Zeile2, 1).Text & "|" & .Cells(Zeile2, 4).Text
For Zeile1 = LBound(arrKeys) to Zeile1_L
If strSuch = arrKeys(Zeile1) then
'Datum übertragen
wks1.Cells(Zeile1, 7).Value = .Cells(Zeile2, 7).Value
End if
Next Zeile1
End If
Next Zeile2
End With
End Sub

Die Variablen wks1 und wks2 stehen hier für die beiden Tabellenblätter.
Die Tabellenblätter müssen den Variablen per Set-Anweisung zugewiesen werden.
Dieses Makro kann auch bei einer eindeutigen ID verwenden (strSuch besteht dann nur aus den Werten einer Spalte. Die Such-funktion ist aber normalerweise schneller als das Abarbeiten von Schleifen.
Gruß
Franz
Anzeige
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 15:47:25
Gregy
Hallo Franz,
vielen Dank für Deine Antwort und das angefügte Skript. Ich habe das mal kopiert und als Sub eingefügt. Ich habe mich für die Variante der ID-Zuordnung entschieden.
Die Tabelle überträgt vom Protokoll in die Aufgabenliste die IDs (das hat zumindest schon einmal geklappt). Die IDs sind in Spalte Q der jeweiligen Zeilen gelistet. Ich habe Dein Code versucht umzuschreiben auf die jetzigen bedingungen (mit weniger Erfolg wie gewünscht :-/). Hier ist er:
Sub datum_uebertragen()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zeile1 As Long, Zeile2 As Long, Zeile1_L As Long
Dim arrKeys() As String, strSuch As String
Set wks1 = Tabelle1
Set wks2 = Tabelle4
'Schluesselwerte aus Tabelle1 in Array speichern
With wks1
Zeile1_L = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim arrKeys(15 To Zeile1_L)
For Zeile1 = LBound(arrKeys) To Zeile1_L
'das strSuch behandelt jetzt nur noch die Zeilen der Spalte Q wo die IDs gelistet sind
strSuch = .Cells(Zeile1, 17).Text
arrKeys(Zeile1) = strSuch
Next
End With
'Zeilen in Tabelle1 abarbeiten
With wks2
For Zeile2 = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
'Prüfen, ob Erledigt-Datum in 2. Tabelle eingetragen ist
If .Cells(Zeile2, 7).Value  "" Then
'Werte aus Spalten A und D zu Schlüsselwert/Suchbegriff zusammenfügen
strSuch = .Cells(Zeile2, 17).Text
For Zeile1 = LBound(arrKeys) To Zeile1_L
If strSuch = arrKeys(Zeile1) Then
'Datum übertragen
wks1.Cells(Zeile1, 7).Value = .Cells(Zeile2, 7).Value
End If
Next Zeile1
End If
Next Zeile2
End With
End Sub
Zunächste habe ich die Tabellen-Sets angepasst (es findet alles in einer Tabelle mit mehreren Tabellenblättern statt). Dann habe ich strSuch angepasst, da ja nun kein Array mehr gebildet werden braucht. An der Stelle war ich unsicher, ob ich das Array komplett rausnehmen kann, da ich nicht weiss, was weiter hinten im Code damit geschieht...
Ich danke scheon einmal vielmals für die Unterstützung.
Gruß
Gregy
Anzeige
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 18:56:34
fcs
Hallo Gregy,
eigentlich sieht das Makro so OK aus.
Zum weiteren Testen bräuchte ich eine Beispieldatei mit den beiden Tabellenblättern wie sie vor der Makroausführung aussehen können plus das von dir angepasste Makro.
Personenbezogene oder andere wichtige Daten kannst du ja anonymisieren.
Das Array im Makro ist auch mit ID sinnvoll, da es die Ausführung des Makros bei vieln Datensätzen stark beschleunit. Denn Datenarrays werden Makro sehr viel schneller abgearbeitet als die Zugriffe auf Tabellenzellen.
LG
Franz
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 15:47:36
Gregy
Hallo Franz,
vielen Dank für Deine Antwort und das angefügte Skript. Ich habe das mal kopiert und als Sub eingefügt. Ich habe mich für die Variante der ID-Zuordnung entschieden.
Die Tabelle überträgt vom Protokoll in die Aufgabenliste die IDs (das hat zumindest schon einmal geklappt). Die IDs sind in Spalte Q der jeweiligen Zeilen gelistet. Ich habe Dein Code versucht umzuschreiben auf die jetzigen bedingungen (mit weniger Erfolg wie gewünscht :-/). Hier ist er:
Sub datum_uebertragen()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zeile1 As Long, Zeile2 As Long, Zeile1_L As Long
Dim arrKeys() As String, strSuch As String
Set wks1 = Tabelle1
Set wks2 = Tabelle4
'Schluesselwerte aus Tabelle1 in Array speichern
With wks1
Zeile1_L = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim arrKeys(15 To Zeile1_L)
For Zeile1 = LBound(arrKeys) To Zeile1_L
'das strSuch behandelt jetzt nur noch die Zeilen der Spalte Q wo die IDs gelistet sind
strSuch = .Cells(Zeile1, 17).Text
arrKeys(Zeile1) = strSuch
Next
End With
'Zeilen in Tabelle1 abarbeiten
With wks2
For Zeile2 = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
'Prüfen, ob Erledigt-Datum in 2. Tabelle eingetragen ist
If .Cells(Zeile2, 7).Value  "" Then
'Werte aus Spalten A und D zu Schlüsselwert/Suchbegriff zusammenfügen
strSuch = .Cells(Zeile2, 17).Text
For Zeile1 = LBound(arrKeys) To Zeile1_L
If strSuch = arrKeys(Zeile1) Then
'Datum übertragen
wks1.Cells(Zeile1, 7).Value = .Cells(Zeile2, 7).Value
End If
Next Zeile1
End If
Next Zeile2
End With
End Sub
Zunächste habe ich die Tabellen-Sets angepasst (es findet alles in einer Tabelle mit mehreren Tabellenblättern statt). Dann habe ich strSuch angepasst, da ja nun kein Array mehr gebildet werden braucht. An der Stelle war ich unsicher, ob ich das Array komplett rausnehmen kann, da ich nicht weiss, was weiter hinten im Code damit geschieht...
Ich danke scheon einmal vielmals für die Unterstützung.
Gruß
Gregy
Anzeige
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 16:16:48
Gregy
Hallo Franz,
wie ich grade gesehen habe, fehlt bei meiner Nachricht die eigentliche Fehlerbeschreibung...
Wenn ich den von mir angepassten Code ausführe, werden in das Tabellenblatt 1 (das Protokoll) in jede Zeile der Spalte G das Datum eines Datensatzes aus Tabellenblatt 2 übertragen (welcher ist für mich nicht klar erkenn- oder simulierbar...)
Ich hänge die Tabelle mal an
https://www.herber.de/bbs/user/110916.xlsm
Gruß
Gregy
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 16:16:52
Gregy
Hallo Franz,
wie ich grade gesehen habe, fehlt bei meiner Nachricht die eigentliche Fehlerbeschreibung...
Wenn ich den von mir angepassten Code ausführe, werden in das Tabellenblatt 1 (das Protokoll) in jede Zeile der Spalte G das Datum eines Datensatzes aus Tabellenblatt 2 übertragen (welcher ist für mich nicht klar erkenn- oder simulierbar...)
Ich hänge die Tabelle mal an
https://www.herber.de/bbs/user/110916.xlsm
Gruß
Gregy
Anzeige
AW: Datenaustausch zwischen zwei Tabellenblättern
26.01.2017 19:05:38
fcs
Hallo Gregy,
ich hatte deine Antwort mit Datei nicht gleich gesehen.
Bei dir steht die ID (Positionsnummer in Spalte A = 1 und nicht in Spalte Q.
Mit den Folgenden Korrekturen sollte die bertragung des Datums funktionieren.
LG
Franz
Sub datum_uebertragen()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim Zeile1 As Long, Zeile2 As Long, Zeile1_L As Long
Dim arrKeys() As String, strSuch As String
Set wks1 = Sheets("Protokoll (1)")
Set wks2 = Sheets("Aufgabenausgabe")
'Schluesselwerte aus Tabelle1 in Array speichern
With wks1
Zeile1_L = .Cells(.Rows.Count, 3).End(xlUp).Row
ReDim arrKeys(15 To Zeile1_L)
For Zeile1 = LBound(arrKeys) To Zeile1_L
'Werte aus Spalten A und D zu Schlüsselwert zusammenfügen
strSuch = .Cells(Zeile1, 1).Text
arrKeys(Zeile1) = strSuch
Next
End With
'Zeilen in Tabelle1 abarbeiten
With wks2
For Zeile2 = 2 To .Cells(.Rows.Count, 3).End(xlUp).Row
'Prüfen, ob Erledigt-Datum in 2. Tabelle eingetragen ist
If .Cells(Zeile2, 7).Value  "" Then
'Werte aus Spalten A und D zu Schlüsselwert/Suchbegriff zusammenfügen
strSuch = .Cells(Zeile2, 1).Text
For Zeile1 = LBound(arrKeys) To Zeile1_L
If strSuch = arrKeys(Zeile1) Then
'Datum übertragen
wks1.Cells(Zeile1, 7).Value = .Cells(Zeile2, 7).Value
End If
Next Zeile1
End If
Next Zeile2
End With
End Sub

Anzeige

327 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige