einfügen anhand mehreren Zielbed.

Guten Tag
Ich schreibe gerade an einem Tool wo der Nutzer verschiedene Daten in ein Eingabeblatt einfüllen muss. In diesem Eingabeblatt kann er auswählen, für welches Jahr und für welchen Standort er die Daten eingibt. Seine Daten sollen dann in einem zweiten Tabellenblatt für den richtigen Standort, das richtige Jahr und beim korrekten Eingabewert abgelegt werden.
Nun schaffe ich es, dass der Wert kopiert und in das andere Tabellenblatt kopiert wird, aber ich kann nicht definieren sohin genau die Daten kopiert werden.
In der Zieltabelle sind in den ersten beiden Spalten zuerst die Standorte (25 Stk) und dann jeweils alle Jahre (10 Stk) pro Standort definiert. Pro weitere Spalte werden dann die Eingabewerte aufgeführt. Das Makro soll nun anhand der Definition von Standort und Jahr im Eingabeblatt die Daten des Eingabewertes an den Ort in der Zieltabelle speichern wo Standort, Jahr und Eingabewert stimmen. Ich habe hier versucht das ganze etwas darzustellen und hoffe das funktioniert so von der Formatierung her.
Standort Jahr Eingabewert1 Eingabewert2 Eingabewert3
x 2010
y 2012
z 2014
Ich hoffe ich konnte mich einigermaßen verständlich ausdrücken und hoffe auf eine Eurer hoch kompetenten Antworten. Vielen Dank!
momei

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub t() Dim WS1 As Worksheet, WS2 As Worksheet Dim Zeile As Long Set WS1 = Worksheets("Dtb_ein") Set WS2 = Worksheets("Eingabe") With WS1 If WorksheetFunction.CountIf(.Columns(1), WS2.Range("A5")) = 0 Then MsgBox "Gemeinde ist auf Blatt Dtb_ein nicht vorhanden" Else Zeile = Application.Match(WS2.Range("A5"), .Columns(1), 0) + WS2.Range("D5") - 2000 .Cells(Zeile, 3) = WS2.Range("D9").Value .Cells(Zeile, 4) = WS2.Range("D9").Value .Cells(Zeile, 5) = WS2.Range("E9").Value .Cells(Zeile, 6) = WS2.Range("F9").Value 'usw. End If End With End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range) Dim WS1 As Worksheet, WS2 As Worksheet Dim Zeile As Long Set WS1 = Worksheets("Dtb_ein") Set WS2 = Worksheets("Eingabe") With WS1 If WorksheetFunction.CountIf(.Columns(1), WS2.Range("A5")) = 0 Then MsgBox "Noch keine Daten zu gewählter Gemeinde eingegeben." Else Zeile = Application.Match(WS2.Range("A5"), .Columns(1), 0) + WS2.Range("D5") - 2000 .Cells(Zeile, 3) = WS2.Range("C9").Value .Cells(Zeile, 4) = WS2.Range("D9").Value .Cells(Zeile, 5) = WS2.Range("E9").Value .Cells(Zeile, 6) = WS2.Range("F9").Value .Cells(Zeile, 7) = WS2.Range("G9").Value .Cells(Zeile, 8) = WS2.Range("H9").Value .Cells(Zeile, 9) = WS2.Range("I9").Value End If End With End Sub

Hi
Thema 1: Suche nach dem Jahr kann ich dir (morgen) lösen. Mein Ansatz war sowieso etwas faul :)
Thema 2: Ja kann man mit Schleife lösen. Bezogen auf deinen Beispielcode stimmen die Spalten sogar zufälligerweise überein, darum ganz einfach:
For i = 3 To 6
.Cells(Zeile, i) = WS2.Cells(9, i).Value
Next i
Später werden die Spalten versetzt sein, dann mit Addition hoch rechnen z.B.
For i = 3 To 6
.Cells(Zeile, i) = WS2.Cells(9, i).Value
Next i
For i = 3 To 6
.Cells(Zeile, i + 7) = WS2.Cells(9, i).Value
Next i
D.h. es laufen mehrere Schleifen nach einander.
Jetzt wäre es natürlich noch schöner, wenn man gleich alle 900 Datenfelder in einem Wisch übertragen könnte. Hierzu ist aber eine möglichst einheitliche Datenstruktur notwendig bzw. sehr hilfreich.
Randbemerkung: Bei 900 Datenfeldern ist ein möglichst "generischer" Code anzustreben. Je weniger Ausnahmen/Spezialfälle in der Datenstruktur, desto weniger hast du bei einer allfälligen Änderung im Code anzupassen.
Was mir bezüglich Datenstruktur nicht gefällt, sind die Leerzeilen auf Blatt "Eingabe". Die Titel liessen sich z.B. anhand der Formatierung erkennen, aber dann gibt es noch Ausnahmen z.B. Zeile 82, 89, 96. VBA-technisch einfacher wäre es z.B. die Tabelle eine Spalte nach rechts zu schieben und die Titel in einer separaten Spalte A zu schreiben (Ziel: Leerzeilen emliminieren oder mindestens die Ausnahmen reduzieren).
Noch "unglücklicher" scheint mir die Tatsache, dass du je Zeile eine unterschiedliche Anzahl Spalten überträgst. (Auf Blatt Dtb_ein, CH:CL = 5, CM:CS = 7)
Thema 3: Event/Ereignis
Definitiv solltest du kein SelectionChange Ereignis verwenden (läuft bei jedem Klick). Eher ein Worksheet_Change Ereignis (reagiert auf Änderung des Zellwertes).
Aber auch mit Change könntest du es bei 900 Zellen spüren (kleinste nervige Verzögerungen bei der Eingabe). Die Variante z.B. mit Speichern-Button hätte den Vorteil, dass du das Eingabeformular für die nächste Eingabe zurück setzen könntest und eine Plausibilitätsprüfung (z.B. wurden alle Pflichtfelder erfasst, Zahl = Zahl, Text = Text usw.) einsetzen könntest. Zudem überschreibt niemand unbewusst die Daten (z.B. weil man vergisst das Jahr umzustellen).
Thema 4: Allgmein
Mein Bauch sagt mir, die Aufgabe könnte ein Fass ohne Boden werden. Die Daten sollen für Änderungen doch später sicher von der DB zurück ins Formular geschrieben werden? ;)
(bereits vorweg, auch hier hilft eine möglichst einheitliche Datenstruktur, weil du sonst jede Ausnahme quasi rückwärts programmierst ;)
Sind es ca. 2000 Gemeinden à 10 Jahre = 20'000? (bitte grobe Schätzung zur Anzahl Datensätze)
Wieviele unterschiedliche Benutzer der Datei gibt es?
Sollen auch mehrere Benutzer gleichzeitig an der Datei arbeiten?
Wie sieht der Arbeitsprozess aus. Nimmst du die Daten "zentral" auf oder verschickst du Formulare, die du dann wieder konsolidierst/überträgst?
cu
Chris

Sub t() Dim WS1 As Worksheet, WS2 As Worksheet Dim Zeile As Long, Spalte As Long Dim i As Long, j As Long Set WS1 = Worksheets("Dtb_ein") Set WS2 = Worksheets("Eingabe") With WS1 'Zeile finden For i = 7 To .Cells(Rows.Count, 1).End(xlUp).Row If .Cells(i, 1) = WS2.Range("A5") And _ .Cells(i, 2) = WS2.Range("D5") Then Zeile = i Exit For End If Next i If Zeile = 0 Then MsgBox "Gemeinde ist auf Blatt Dtb_ein nicht vorhanden" Else Spalte = 2 For i = 9 To WS2.Cells(Rows.Count, 3).End(xlUp).Row If WS2.Cells(i, 3) "" Then For j = 3 To 8 Spalte = Spalte + 1 .Cells(Zeile, Spalte) = WS2.Cells(i, j).Value Next j End If Next i End If End With End Sub

cNbrOfYears = 10 'Anzahl moegliche Bilanzjahre Const Streingabe = "C9:I151" Private Sub Worksheet_Change(ByVal Target As Range) Dim WSDtbein As Worksheet, WSEing As Worksheet Dim Zeile As Long, Spalte As Long Dim i As Long, j As Long, iOffset As Long Dim rFound As Range Dim sSearch As String If Intersect(Target, Range(Streingabe)) Is Nothing Then Exit Sub 'Ausführung ob Änderung im _ Bereich Application.ScreenUpdating = False Set WSDtbein = Worksheets("Dtb_ein") Set WSEing = Worksheets("Eingabe") iOffset = 5 'Offset fuer Definition Zielzeile With WSDtbein 'Zielzeile fuer das gewaehlte Jahr finden Zeile = iOffset + WSEing.Cells(5, 2).Value * cNbrOfYears - WSEing.Cells(5, 5).Value 'Inhalte kopieren If Zeile "" Then 'Kontrolle ob Spalte C nicht leer sSearch = "=" & Me.Name & "!A" & i 'Erstellung Suchbegriff Set rFound = WSDtbein.Rows("4:4").Find(What:=sSearch, LookIn:=xlFormulas, LookAt:= _ xlWhole, SearchDirection:=xlNext, MatchCase:=False) 'Suche des Suchbegriffes in If rFound Is Nothing Then 'Hier moeglichkeit fuer Fehlerpruefung Else WSEing.Range("C" & i & ":I" & i).Copy 'Kopieren des veraenderten Range .Activate .Cells(Zeile, rFound.Column).PasteSpecial xlPasteValues 'Einfuegen der kopierten _ Werte in Zielzelle wie oben definiert End If End If End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

einfügen anhand mehreren Zielbed.

10 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

10
Beiträge zum Forumthread

Beiträge zu diesem Forumthread