AW: Zusammenführen von Tabellen
27.03.2007 19:36:23
Tabellen
Hallo Pit-tip,
ich hab die Prozedur jetzt nochmal angepasst.
Für Tabelle 1 und 2 hab ich die Startzeile auf 3 gesetzt, so sollte die Titelzeile nicht mehr nach Tabelle 3 übertragen werden.
Ich hab zusätzlich Zeilen eingefügt, die die Zellinhalte aus den Spalten D bis GZ jeweils in einem Block in die Tabelle 3 übertragen und hinter dem aus der Tabelle 2 übernommenen Wert einfügen.
Gruß
Franz
Sub Aus1und2mach3()
Dim wb As Workbook, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim Zeile1 As Long, Zeile2 As Long, Zeile3 As Long
Dim Spalte1 As Integer, Spalte1L As Integer, Spalte2 As Integer, Spalte3 As Integer
Set wb = ActiveWorkbook
Set wks1 = wb.Worksheets("Tabelle1")
Set wks2 = wb.Worksheets("Tabelle2")
Set wks3 = wb.Worksheets("Tabelle3")
'Startzeile in den 3 Tabellen
Zeile1 = 3
Zeile2 = 3
Zeile3 = 2
'Startspalte in den 3 Tabellen
Spalte1 = 1
Spalte1L = 208 'Letzte Spalte (GZ) in Tabelle 1 mit Daten
Spalte2 = 1
Spalte3 = 1
'vorhandene Daten in Tabelle 3 löschen
With wks3
.Range(.Cells(Zeile3, Spalte3), .Cells(Application.WorksheetFunction.Max(Zeile3, _
.Cells(.Rows.Count, Spalte3).End(xlUp).Row), Spalte3 + Spalte1L)).ClearContents
End With
For Zeile2 = Zeile2 To wks2.Cells(wks2.Rows.Count, Spalte1).End(xlUp).Row
'Ziffern/Zeilen übernehmen, die in Tabelle1 nicht vorkommen
Do Until wks1.Cells(Zeile1, Spalte1) = wks2.Cells(Zeile2, Spalte2)
wks3.Cells(Zeile3, Spalte3) = wks2.Cells(Zeile2, Spalte2)
wks3.Cells(Zeile3, Spalte3 + 1) = ""
wks3.Cells(Zeile3, Spalte3 + 2) = ""
wks3.Cells(Zeile3, Spalte3 + 3) = wks2.Cells(Zeile2, Spalte2 + 1)
wks3.Range(wks3.Cells(Zeile3, Spalte3 + 4), _
wks3.Cells(Zeile3, Spalte3 + 4 + Spalte1L - Spalte1 - 3)).Value = ""
Zeile2 = Zeile2 + 1
If Zeile2 > wks2.Cells(wks2.Rows.Count, Spalte1).End(xlUp).Row Then Exit For
Zeile3 = Zeile3 + 1
Loop
'Ziffern/Zeilen übernehmen aus Tabelle1 und Wert aus Tabelle2 ergänzen
Do Until wks1.Cells(Zeile1, Spalte1) wks2.Cells(Zeile2, Spalte2)
wks3.Cells(Zeile3, Spalte3) = wks1.Cells(Zeile1, Spalte1)
wks3.Cells(Zeile3, Spalte3 + 1) = wks1.Cells(Zeile1, Spalte1 + 1)
wks3.Cells(Zeile3, Spalte3 + 2) = wks1.Cells(Zeile1, Spalte1 + 2)
wks3.Cells(Zeile3, Spalte3 + 3) = wks2.Cells(Zeile2, Spalte2 + 1)
'Werte aus Spalten D bis GZ aus Tabelle 1 einfügen
wks3.Range(wks3.Cells(Zeile3, Spalte3 + 4), _
wks3.Cells(Zeile3, Spalte3 + 4 + Spalte1L - Spalte1 - 3)).Value _
= wks1.Range(wks1.Cells(Zeile1, Spalte1 + 3), wks1.Cells(Zeile1, Spalte1L)).Value
Zeile1 = Zeile1 + 1
Zeile3 = Zeile3 + 1
Loop
Next Zeile2
'Restliche Zeilen aus Tabelle1 übernehmen ohne Nummer in Tabelle2
Do Until wks1.Cells(Zeile1, Spalte1) = ""
wks3.Cells(Zeile3, Spalte3) = wks1.Cells(Zeile1, Spalte1)
wks3.Cells(Zeile3, Spalte3 + 1) = wks1.Cells(Zeile1, Spalte1 + 1)
wks3.Cells(Zeile3, Spalte3 + 2) = wks1.Cells(Zeile1, Spalte1 + 2)
wks3.Cells(Zeile3, Spalte3 + 3) = ""
'Werte aus Spalten D bis GZ aus Tabelle 1 einfügen
wks3.Range(wks3.Cells(Zeile3, Spalte3 + 4), _
wks3.Cells(Zeile3, Spalte3 + 4 + Spalte1L - Spalte1 - 3)).Value _
= wks1.Range(wks1.Cells(Zeile1, Spalte1 + 3), wks1.Cells(Zeile1, Spalte1L)).Value
Zeile1 = Zeile1 + 1
Zeile3 = Zeile3 + 1
Loop
End Sub