Werte in Tab.1 suchen und in Tab.2 ausgeben

Hallo zusammen,
folgendes Problem:
in Tabelle 1 hab ich die Spalten Struktur, Aktivitäten, Stunden und Kosten.
Hier wird nur die tatsächlich entstehende Arbeit mit Stunden und Kosten eingegeben.
in Tabelle 2 hab ich die gesamte Struktur eines Projektes (Pkt. 01 bis 04).
Wenn ich jetzt ein Makro starte, sollte das was in Tabelle 1 steht in die entsprechende Struktur in Tabelle 2 eingefügt werden. Wenn kein Platzt mehr da ist (in Tabelle 2), sollte auch eine Zeile eingefügt werden.
Also d.h.: Suche A2 (Tabelle1) in A1 bis A100 (Tabelle2) wenn es gefunden wird, dann nimm B2 bis D2 (Tabelle1) und kopiere es in Tabelle 2 unter der gefunden Nummer in das nächte leere Feld (wenn kein Leeres Feld vorhanden ist, dann eine Zeile einfügen). Dann geh wieder Tabelle 1 und such A3 ...usw.
Um es besser zu verstehen hab ich eine Beispieldatei erstellt (siehe Anhang).
https://www.herber.de/bbs/user/49027.xls
Die Lösung sollte mit Makro realisiert werden.
Danke.
Gruß
Andreas

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Andreas,
vom Grundsatz her tut es folgendes Makro:


Sub StrukturAusfuellen()
Dim wksData As Worksheet, wksStruk As Worksheet, suchbegriff
Dim Zelle As Range, ZeileData As Long, i As Integer
Set wksData = Worksheets("Tabelle1")
Set wksStruk = Worksheets("Tabelle2")
With wksData
For ZeileData = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
suchbegriff = .Cells(ZeileData, 1)
Set Zelle = wksStruk.Range("A:A").Find(what:=suchbegriff, LookIn:=xlValues, _
lookat:=xlWhole)
If Zelle Is Nothing Then
MsgBox "Struktur-Nr. " & suchbegriff & " nicht gefunden!"
Else
i = 1
'Leere Zeile in Spalte B suchen
Do Until Zelle.Offset(i, 1) = ""
i = i + 1
Loop
'Prüfen ob in Spalte A ein Einrag (Strukturnummer) vorhanden
If Zelle.Offset(i, 0)  "" Then
Zelle.Offset(i, 0).EntireRow.Insert
End If
Zelle.Offset(i, 1).Value = .Cells(ZeileData, 2).Value
Zelle.Offset(i, 2).Value = .Cells(ZeileData, 3).Value
Zelle.Offset(i, 3).Value = .Cells(ZeileData, 4).Value
End If
Next
End With
End Sub

Damit es reibungslos funktioniert muss du in Tabelle 2 die als "verbunden" formatierten Zellen wieder in Einzelzellen auflösen. Diese Formatierung ist hier nicht erforderlich und erschwert nur die Makrofunktion/-programmierung.
Die Schreibweisen der Strukturnummern in den beiden Tabellen müssen exakt übereinstimmen! Die Bindestriche in Tabelle1 vor den Nummern müssen also verschwinden, oder du muss den Suchbegriff für die Tabelle2 irgendwie zusätzlich per Formel im Code festlegen.
Gruß
Franz

Sub StrukturAusfuellen() Dim wksData As Worksheet, wksStruk As Worksheet, suchbegriff Dim Zelle As Range, ZeileData As Long, i As Integer Set wksData = Worksheets("Tabelle1") Set wksStruk = Worksheets("Tabelle2") With wksData For ZeileData = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row suchbegriff = .Cells(ZeileData, 1) Set Zelle = wksStruk.Range("A:A").Find(what:=suchbegriff, LookIn:=xlValues, _ lookat:=xlWhole) If Zelle Is Nothing Then MsgBox "Struktur-Nr. " & suchbegriff & " nicht gefunden!" Else i = 1 'Leere Zeile in Spalte B suchen Do Until Zelle.Offset(i, 1) = "" 'Prüfen ob Eintrag Spalte B schon vorhanden If Zelle.Offset(i, 1).Value = .Cells(ZeileData, 2).Value Then '? Zelle.Offset(i, 2).Value = .Cells(ZeileData, 3).Value 'Stunden '? Zelle.Offset(i, 3).Value = .Cells(ZeileData, 4).Value ' GoTo NextEintrag End If i = i + 1 Loop 'Prüfen ob in Spalte A ein Eintrag (Strukturnummer) vorhanden If Zelle.Offset(i, 0) "" Then Zelle.Offset(i, 0).EntireRow.Insert End If Zelle.Offset(i, 1).Value = .Cells(ZeileData, 2).Value Zelle.Offset(i, 2).Value = .Cells(ZeileData, 3).Value Zelle.Offset(i, 3).Value = .Cells(ZeileData, 4).Value End If NextEintrag: Next End With End Sub

Beliebteste Forumthreads (12 Monate)

Werte in Tab.1 suchen und in Tab.2 ausgeben

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Werte in Tab.1 suchen und in Tab.2 ausgeben

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

322 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread