Supportnet Computer
Planet of Tech

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

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

Antwort 3 von fürLau

Hallo
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
www.netupload.de

Zitat:
Sieht jemand eine Möglichkeit dies zu automatisieren??
mit genügend Informationen bestimmt
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

Antwort 5 von acira

Dateiupload Nachtrag

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ß

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!

Antwort 8 von fürLau

Hallo

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

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

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

Antwort 12 von fürLau

Hallo @acira

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

Ich möchte kostenlos eine Frage an die Mitglieder stellen:


Ähnliche Themen:


Suche in allen vorhandenen Beiträgen: