Supportnet / Forum / Tabellenkalkulation
Datensätze in verschiedene Blätter kopieren
Frage
Hallo zusammen,
lese hier schon ein wenig im Forum und habe auch das eine oder andere nützliche gefunden. Jetzt habe ich ein spezielles Problem und (noch) keinen Lösungsansatz gefunden. Bin für jede Hilfe dankbar.
Datensatz:
Land; Jahr; Monat; A1; A2; B1; B2; ...
GER; 2006; Januar; Wert_A1; Wert_A2; ...
GER; 2006; Februar; Wert_A1; Wert_A2; ...
GER; 2005; Januar; Wert_A1; Wert_A2; ...
AUT; 2006; Januar; Wert_A1; Wert_A2; ...
...
Diese Werte sollen nun in verschiedene Blätter übertragen werden:
z.B. Blatt GER
Wert_A1=D7
Wert_A2=D20
Es gibt mehrere Länderblätter mit jeweils einer Datentabelle und immer den selben Zielzellen abhänig halt vom Land (Blatt), Jahr und Monat. Die Spaltenzuweisung ist fest.
Es liegen Daten seit 2005 vor und werden jeden Monat erweitert. Dementsprechend mühselig wäre eine Datenübertragung von Hand.
Sieht jemand eine Möglichkeit dies zu automatisieren??
Ich bin kein VBA-Experte, habe aber schon ein paar Gehversuche hinter mir. Hoffe ich habe das Problem verständlich dargelegt!?
Vielen Dank schonmal
Gruß
acira
Antwort 1 von Saarbauer
Hallo,
sind die zu übernehmenden Daten, wie im Beispiel Blatt GER
Wert_A1=D7
Wert_A2=D20
immer din den Zellen D7 und D20 ?
Sind die Datenblätter immer in einer Datei ?
Dann könnte man ein Makro nutzen.
Als Ansatz hier die Ermittlung des Blattnamens
https://supportnet.de/threads/1100493
Gruß
Helmut
sind die zu übernehmenden Daten, wie im Beispiel Blatt GER
Wert_A1=D7
Wert_A2=D20
immer din den Zellen D7 und D20 ?
Sind die Datenblätter immer in einer Datei ?
Dann könnte man ein Makro nutzen.
Als Ansatz hier die Ermittlung des Blattnamens
https://supportnet.de/threads/1100493
Gruß
Helmut
Antwort 2 von acira
Hallo Helmut,
danke für die Formel. Die kannte ich auch schon. :-)
Ja, die Zellbezüge sind immer fest und die Daten werden als extra (versteckte) Tabelle in der Datei sein.
Werde mal sehen wie weit ich so komme. Weitere Anregungen sind natürlich immer gern willkommen. ;-)
Gruß
acira
danke für die Formel. Die kannte ich auch schon. :-)
Ja, die Zellbezüge sind immer fest und die Daten werden als extra (versteckte) Tabelle in der Datei sein.
Werde mal sehen wie weit ich so komme. Weitere Anregungen sind natürlich immer gern willkommen. ;-)
Gruß
acira
Antwort 3 von fürLau
Hallo
www.netupload.de
Gruß
Zitat:
Hoffe ich habe das Problem verständlich dargelegt!?
Hast Du eben nicht! Ich jedenfalls kann es nicht nachvollziehen. Besteht Deinerseits die Möglichkeit die Arbeits-Mappe zu veröffentlichen? z.B.bei Hoffe ich habe das Problem verständlich dargelegt!?
www.netupload.de
Zitat:
Sieht jemand eine Möglichkeit dies zu automatisieren??
mit genügend Informationen bestimmtSieht jemand eine Möglichkeit dies zu automatisieren??
Gruß
Antwort 4 von acira
Hallo fürLau,
habe mal zwei Dummies hochgeladen. Zieldatei und Quelldatenmaske. Die Orginaldaten sind halt vertraulich. Aber die Struktur wird so sein (naja werden "einige" Daten mehr sein).
http://www.netupload.de/detail.php?img=8cc64f14d791a387fa0aabc8e28484ff.xls
http://www.netupload.de/detail.php?img=0246a53e5a493e833fa8671a6906869a.xls
Ist es damit verständlich? Ich versuchs auch gern nochmal anders darzulegen. Alles was benötigt wird ;-)
Danke&Gruß
acira
habe mal zwei Dummies hochgeladen. Zieldatei und Quelldatenmaske. Die Orginaldaten sind halt vertraulich. Aber die Struktur wird so sein (naja werden "einige" Daten mehr sein).
http://www.netupload.de/detail.php?img=8cc64f14d791a387fa0aabc8e28484ff.xls
http://www.netupload.de/detail.php?img=0246a53e5a493e833fa8671a6906869a.xls
Ist es damit verständlich? Ich versuchs auch gern nochmal anders darzulegen. Alles was benötigt wird ;-)
Danke&Gruß
acira
Antwort 5 von acira
Dateiupload Nachtrag
Sorry, hatte vergessen ein Testmakro vor dem Upload zu löschen.
Gruß
acira
Sorry, hatte vergessen ein Testmakro vor dem Upload zu löschen.
Gruß
acira
Antwort 6 von fürLau
Hallo
Die beiden Dateien scheinen identisch zu sein.
.;-(keine Quell-Daten.
Gruß
Die beiden Dateien scheinen identisch zu sein.
.;-(keine Quell-Daten.
Gruß
Antwort 7 von acira
*grummel*
heute ist anscheinend nicht mein Tag. Sorry!
Hier nochmal beide Dateien. Es hat sich auch glatt nochmal was geändert. Aber jetzt bleibt das so.
http://www.netupload.de/detail.php?img=16ed54620421c094fb6a929be49ff918.xls
http://www.netupload.de/detail.php?img=6461781022e4955b87f8498c42f7cf55.xls
Gruß
acira
P.S. Danke für die Geduld!
heute ist anscheinend nicht mein Tag. Sorry!
Hier nochmal beide Dateien. Es hat sich auch glatt nochmal was geändert. Aber jetzt bleibt das so.
http://www.netupload.de/detail.php?img=16ed54620421c094fb6a929be49ff918.xls
http://www.netupload.de/detail.php?img=6461781022e4955b87f8498c42f7cf55.xls
Gruß
acira
P.S. Danke für die Geduld!
Antwort 8 von fürLau
Hallo
Hier bitteschön das Makro:
Platziere in Deiner Quelldatei eine Befehlsshaltfläche und kopiere das Makro in den Codebereich der Tabelle.
Leider sind die Beispieldaten recht ungünstig gewählt und unvollständig.
Gruß fürLau
Hier bitteschön das Makro:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const ziel = "acira-zieldatei.xls", quel = "acira-quelldatenmaske.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%
For Zaehler = 2 To Range("A65535").End(xlUp).Row
ReDim Werte(8)
For wert = 1 To 8
Werte(wert) = Cells(Zaehler, wert) ´Quell-zeileninhalt einlesen
Next wert
Workbooks(ziel).Activate ´Zieldatei
Worksheets(Werte(1)).Activate ´Ländertabelle
If Werte(2) = 2006 Then zsr = 7 Else zsr = 20 ´Jahr Wählen
For Zeile = zsr To zsr + 12 ´Monate suchen
If ActiveSheet.Cells(Zeile, 2) = Werte(3) Then Exit For
Next Zeile
For Spalte = 2 To 20 ´marke suchen
If ActiveSheet.Cells(2, Spalte).Value = Werte(4) Then Exit For
Next Spalte
For wert = 1 To 4
ActiveSheet.Cells(Zeile, Spalte + wert - 1).Value = Werte(wert + 4) ´Werte eintragen
Next wert
Workbooks(quel).Activate
Next Zaehler
Application.ScreenUpdating = True
End Sub
Platziere in Deiner Quelldatei eine Befehlsshaltfläche und kopiere das Makro in den Codebereich der Tabelle.
Leider sind die Beispieldaten recht ungünstig gewählt und unvollständig.
Gruß fürLau
Antwort 9 von acira
Hallo fürLau,
Dankeschön.
Ja, ich weiß daß die Quelldaten nicht toll und unvollständig waren. Habe aber auf Arbeit grad ne Menge zu tun. Und der richtige Datensatz steht mir bisher noch nicht zur Verfügung (davon abgsehen dass ich die Daten eh nicht veröffentlichen kann). Daher die kleinen Dummy Dateien, damit so einigermaßen klar wird worauf ich hinaus will/muß. Wenn ich die Daten erstmal hab, muß auch recht fix gehen.
Von daher nochmals Danke! Versuche das heute noch umzusetzen. Die Kommentare sind da schon jetzt hilfreich. :-)
Gruß
acira
Dankeschön.
Ja, ich weiß daß die Quelldaten nicht toll und unvollständig waren. Habe aber auf Arbeit grad ne Menge zu tun. Und der richtige Datensatz steht mir bisher noch nicht zur Verfügung (davon abgsehen dass ich die Daten eh nicht veröffentlichen kann). Daher die kleinen Dummy Dateien, damit so einigermaßen klar wird worauf ich hinaus will/muß. Wenn ich die Daten erstmal hab, muß auch recht fix gehen.
Von daher nochmals Danke! Versuche das heute noch umzusetzen. Die Kommentare sind da schon jetzt hilfreich. :-)
Gruß
acira
Antwort 10 von acira
Hallo fürLau,
nach näherer Betrachtung kann ich nur nochmals danke sagen!! Funzt alles wunderbar. Habe zwar Dein Makro bis jetzt noch nicht anpassen können, da sich immer noch was ändert, aber Du hast mir mit dem Makro sehr weitergeholfen!!
Danke&Gruß
acira
nach näherer Betrachtung kann ich nur nochmals danke sagen!! Funzt alles wunderbar. Habe zwar Dein Makro bis jetzt noch nicht anpassen können, da sich immer noch was ändert, aber Du hast mir mit dem Makro sehr weitergeholfen!!
Danke&Gruß
acira
Antwort 11 von acira
Hallo fürLau, hallo an Alle,
wie sollte es anders sein, kurz vor Deadline gibts noch ne gravierende Änderung.
Aufgrund erheblicher Erweiterung der anzugebenen Daten muß ich die Struktur jetzt komplett ändern. Alles was bisher in der Zieldatei in Spalten war muß jetzt in die Zeilen (40 Marken x 13 Werte > 256). :-(
Habe auch bereits versucht das Makro (stümperhaft, ich gebs ja zu) zu ändern, bekomme aber immer nur ein paar Vieren in einer Zeile. Bräuchte nochmal dringend Hilfe.
Hier die aktuallisierten Dateien (diesmal auch mit besser überprüfbaren Daten) und der Code von fürLau:
acira-zieldatei.xls
http://www.netupload.de/detail.php?img=a96a8f48aae492f9e27198b9147f8fec.xls
acira-quelldatenmaske.xls
http://www.netupload.de/detail.php?img=12bf4ca8342ab3597e8bc3b09889c376.xls
Code mit Kommentaren von für Lau und meiner Wenigkeit (für mich zum besseren verstehen)
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const ziel = "acira-zieldatei.xls", quel = "acira-quelldatenmaske.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%
For Zaehler = 2 To Range("A65535").End(xlUp).Row
´festlegen der spaltenanzahl - quell´
ReDim Werte(8)
For wert = 1 To 8
´Quell-zeileninhalt einlesen´
Werte(wert) = Cells(Zaehler, wert)
Next wert
´Zieldatei´
Workbooks(ziel).Activate
´Ländertabelle ´
Worksheets(Werte(1)).Activate
´Jahr Wählen ´
If Werte(2) = 2006 Then zsr = 7 Else zsr = 20
´Monate suchen ´
For Zeile = zsr To zsr + 12
If ActiveSheet.Cells(Zeile, 2) = Werte(3) Then Exit For
Next Zeile
´marke suchen ´
For Spalte = 2 To 20
If ActiveSheet.Cells(2, Spalte).Value = Werte(4) Then Exit For
Next Spalte
´Anzahl der Werte´
For wert = 1 To 4
´Werte eintragen ´
ActiveSheet.Cells(Zeile, Spalte + wert - 1).Value = Werte(wert + 4)
Next wert
Workbooks(quel).Activate
Next Zaehler
Application.ScreenUpdating = True
End Sub
Hilfe wäre Super! Danke!
Gruß
acira
wie sollte es anders sein, kurz vor Deadline gibts noch ne gravierende Änderung.
Aufgrund erheblicher Erweiterung der anzugebenen Daten muß ich die Struktur jetzt komplett ändern. Alles was bisher in der Zieldatei in Spalten war muß jetzt in die Zeilen (40 Marken x 13 Werte > 256). :-(
Habe auch bereits versucht das Makro (stümperhaft, ich gebs ja zu) zu ändern, bekomme aber immer nur ein paar Vieren in einer Zeile. Bräuchte nochmal dringend Hilfe.
Hier die aktuallisierten Dateien (diesmal auch mit besser überprüfbaren Daten) und der Code von fürLau:
acira-zieldatei.xls
http://www.netupload.de/detail.php?img=a96a8f48aae492f9e27198b9147f8fec.xls
acira-quelldatenmaske.xls
http://www.netupload.de/detail.php?img=12bf4ca8342ab3597e8bc3b09889c376.xls
Code mit Kommentaren von für Lau und meiner Wenigkeit (für mich zum besseren verstehen)
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const ziel = "acira-zieldatei.xls", quel = "acira-quelldatenmaske.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%
For Zaehler = 2 To Range("A65535").End(xlUp).Row
´festlegen der spaltenanzahl - quell´
ReDim Werte(8)
For wert = 1 To 8
´Quell-zeileninhalt einlesen´
Werte(wert) = Cells(Zaehler, wert)
Next wert
´Zieldatei´
Workbooks(ziel).Activate
´Ländertabelle ´
Worksheets(Werte(1)).Activate
´Jahr Wählen ´
If Werte(2) = 2006 Then zsr = 7 Else zsr = 20
´Monate suchen ´
For Zeile = zsr To zsr + 12
If ActiveSheet.Cells(Zeile, 2) = Werte(3) Then Exit For
Next Zeile
´marke suchen ´
For Spalte = 2 To 20
If ActiveSheet.Cells(2, Spalte).Value = Werte(4) Then Exit For
Next Spalte
´Anzahl der Werte´
For wert = 1 To 4
´Werte eintragen ´
ActiveSheet.Cells(Zeile, Spalte + wert - 1).Value = Werte(wert + 4)
Next wert
Workbooks(quel).Activate
Next Zaehler
Application.ScreenUpdating = True
End Sub
Hilfe wäre Super! Danke!
Gruß
acira
Antwort 12 von fürLau
Hallo @acira
Ohne großen Kommentar:
Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt
Ohne großen Kommentar:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False ´Zum Debuggen diese Zeile auskommentiern!
Const ziel = "acira-zieldatei.xls", quel = "acira-quelldatenmaske.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%, murks%
For Zaehler = 2 To Range("A65535").End(xlUp).Row ´festlegen der Zeilenanzahl - quelldatei
ReDim Werte(8)
For wert = 1 To 8 ´Quell-zeileninhalt einlesen
Werte(wert) = Cells(Zaehler, wert)
Next wert
Workbooks(ziel).Activate ´Zieldatei anwählen
Worksheets(Werte(1)).Activate ´ Ländertabelle anwählen
Select Case Werte(2) ´Jahr Wählen
´Da in Zieldatei unterschiedliche Tabellen für Germany und anderen Ländern macht man murks
Case Is = 2006
If Werte(1) = "Germany" Then
zsr = 7: murks = 3 ´2006 Spalten-Anfang in der deutschen Zieltabelle
Else
If Werte(1) <> "Germany" Then zsr = 8: murks = 2
End If
Case Is = 2005
If Werte(1) = "Germany" Then
zsr = 19: murks = 3
Else
If Werte(1) <> "Germany" Then zsr = 20: murks = 2 ´2005 Spalten-Anfang in den anderen Zieltabellen
End If
End Select
For Spalte = zsr To zsr + 12 ´Monate suchen
ActiveSheet.Cells(murks, Spalte).Select
If ActiveSheet.Cells(murks, Spalte) = Werte(3) Then Exit For ´Wenn Monat gefunden
Next Spalte
For Zeile = 2 To 18 ´Marke suchen
If ActiveSheet.Cells(Zeile, 2).Value = Werte(4) Then Exit For ´Wenn Marke gefunden
Next Zeile
For wert = 1 To 4 ´Anzahl der Werte
ActiveSheet.Cells(Zeile + wert - 1, Spalte).Select
ActiveSheet.Cells(Zeile + wert - 1, Spalte).Value = Werte(wert + 4) ´Werte eintragen
Next wert
Workbooks(quel).Activate ´Quelldatei wählen
Next Zaehler ´Nächste Zeile in Quelldatenmaske
Application.ScreenUpdating = True ´Wenn fertig
End Sub
Gruß[h3]{[h1]Ó¤[sup...fürLau
Signatur wurde ganz und gar ohne SNTool erstellt
Antwort 13 von acira
Hallo fürLau,
Vielen Dank für Deine schnelle Antwort. Hatte mich erst gewundert was Du mit unterschiedlichen Tabellen meinst. SORRY! Die Tabellenblätter sollen für alle Länder gleich sein. Nur die Gesamtstruktur hat sich geändert. Mein Fehler das nicht in alle Länderblätter zu kopieren.
Habe mir das Problem mal heute morgen ausgedruckt mit in die Bahn genommen und Dein Makro umgeschrieben. Anscheinend sollte ich öfter Bahn fahren....es funzt. :-) Jedenfalls soweit ich das beurteilen kann. Hier mal der Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const ziel = "acira-zieldatei-v3.xls", quel = "acira-quelldatenmaske-ver1.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%
For Zaehler = 2 To Range("A65535").End(xlUp).Row
´festlegen der spaltenanzahl - quell´
ReDim Werte(8)
For wert = 1 To 8
´Quell-zeileninhalt einlesen´
Werte(wert) = Cells(Zaehler, wert)
Next wert
´Zieldatei´
Workbooks(ziel).Activate
´Ländertabelle ´
Worksheets(Werte(1)).Activate
´Jahr Wählen ´
If Werte(2) = 2006 Then zsr = 7 Else zsr = 19
´Monate suchen ´
For Spalte = zsr To zsr + 11
If ActiveSheet.Cells(3, Spalte) = Werte(3) Then Exit For
Next Spalte
´marke suchen ´
For Zeile = 4 To 25
If ActiveSheet.Cells(Zeile, 2).Value = Werte(4) Then Exit For
Next Zeile
´Anzahl der Werte´
For wert = 1 To 4
´Werte eintragen ´
ActiveSheet.Cells(Zeile + wert - 1, Spalte).Value = Werte(wert + 4)
Next wert
Workbooks(quel).Activate
Next Zaehler
Application.ScreenUpdating = True
End Sub
Danke nochmal
Gruß
acira
P.S. Wenn jemand noch ne Idee zum schnellen Lösen meines anderen Problems hat, tue sich bitte keinen Zwang an...;-)
https://supportnet.de/threads/1346897
Vielen Dank für Deine schnelle Antwort. Hatte mich erst gewundert was Du mit unterschiedlichen Tabellen meinst. SORRY! Die Tabellenblätter sollen für alle Länder gleich sein. Nur die Gesamtstruktur hat sich geändert. Mein Fehler das nicht in alle Länderblätter zu kopieren.
Habe mir das Problem mal heute morgen ausgedruckt mit in die Bahn genommen und Dein Makro umgeschrieben. Anscheinend sollte ich öfter Bahn fahren....es funzt. :-) Jedenfalls soweit ich das beurteilen kann. Hier mal der Code:
Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Const ziel = "acira-zieldatei-v3.xls", quel = "acira-quelldatenmaske-ver1.xls"
Dim Zeile%, i%, Werte() As Variant, zsr%, zz%, Zaehler&, Monat%, wert%, Spalte%
For Zaehler = 2 To Range("A65535").End(xlUp).Row
´festlegen der spaltenanzahl - quell´
ReDim Werte(8)
For wert = 1 To 8
´Quell-zeileninhalt einlesen´
Werte(wert) = Cells(Zaehler, wert)
Next wert
´Zieldatei´
Workbooks(ziel).Activate
´Ländertabelle ´
Worksheets(Werte(1)).Activate
´Jahr Wählen ´
If Werte(2) = 2006 Then zsr = 7 Else zsr = 19
´Monate suchen ´
For Spalte = zsr To zsr + 11
If ActiveSheet.Cells(3, Spalte) = Werte(3) Then Exit For
Next Spalte
´marke suchen ´
For Zeile = 4 To 25
If ActiveSheet.Cells(Zeile, 2).Value = Werte(4) Then Exit For
Next Zeile
´Anzahl der Werte´
For wert = 1 To 4
´Werte eintragen ´
ActiveSheet.Cells(Zeile + wert - 1, Spalte).Value = Werte(wert + 4)
Next wert
Workbooks(quel).Activate
Next Zaehler
Application.ScreenUpdating = True
End Sub
Danke nochmal
Gruß
acira
P.S. Wenn jemand noch ne Idee zum schnellen Lösen meines anderen Problems hat, tue sich bitte keinen Zwang an...;-)
https://supportnet.de/threads/1346897

