Tabellen vergleichen

Hallo zusammen,
ich habe viel gesucht aber nichts für mich gefunden.
Folgende Problemstellung:
Tab1 und Tab2 sind identich. Die müssen jetzt ab SpA5 bis zur letzten beschriebenen verglichen werden, leere Zellen hat es auch noch.
Wird nun in Tab1 eine Zeile zugefügt muss diese in Tab2 an den gleichen Ort kopiert werden.
Da in Tab1 und in Tab2 ca. 380 Spalten belegt und Formatiert sind sollte im vorab eine Zeile zwecks Formatübernahme in Tab2 eingefügt werden und erst dann die alphanummerischen Werte
Keiner der ca. 380 Spalten darf nachher eine falsche Zuweisung zur Namensspalte A haben.
Ich hoffe ich habe mich einigermaßen klar ausgedrückt.
Anbei ein verkleinertes Mustersheet.
Kann mir bitte jemand helfen ?
https://www.herber.de/bbs/user/84776.xls
Mit freundlichen Grüßen
Manfred

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Zeilen() Dim T1 As Worksheet Dim T2 As Worksheet Dim lRowF As Long Dim lRowL As Long Dim iCol As Integer Dim r As Range Set T1 = Sheets("Tab1") 'Master-Tab Set T2 = Sheets("Tab2") 'Vergleich-Tab iCol = 1 'vergleiche Spalte A lRowF = 5 'vergleiche ab Zeile 5 With T1 lRowL = .Cells(.Rows.Count, iCol).End(xlUp).Row For Each r In .Range(.Cells(lRowF, iCol), .Cells(lRowL, iCol)) If r.Value = T2.Cells(r.Row, iCol).Value Then Else T2.Cells(r.Row, iCol).EntireRow.Insert shift:=xlDown T2.Cells(r.Row, iCol).Value = r.Value End If Next r End With End Sub

Hallo Manfred,
woher soll Excel wissen, ob eine Zeile gelöscht wurde oder eingefügt?
Neuer Ansatz: Den Inhalt von T2 (also des aktive sheet) woanders speichern (im zu erstellenden Blatt TEMP), dann T2 löschen, dort T1 einfügen, die vorhandenen Inhalte aus TEMP übertragen.
Meine Lösung hat bestimmt noch Optimierungspotential.
Alle Formeln werden überschrieben, ich gehe davon aus du hast nur Werte.

Sub MasterAndServant()
Dim T1 As Worksheet
Dim T2 As Worksheet
Dim TTmp As Worksheet
Dim lRowF As Long
Dim lRowL As Long
Dim iCol As Integer
Dim iColLast As Integer
Set T1 = Sheets("Tab1")
Set T2 = ActiveSheet
iCol = 1 'Spalte A
lRowF = 6 'ab Zeile 6 Daten
'Temporäres Sheet erzeugen
Sheets.Add
Set TTmp = ActiveSheet
ActiveSheet.Name = "TEMP"
With TTmp
'TEMP-Blatt vor dem User verstecken
'.Visible = xlSheetVeryHidden
'TEMP-Blatt löschen
.Cells.ClearContents
End With
With T2
'Anzahl Zeilen, Anzahl Spalten
iColLast = .UsedRange.Columns.Count
lRowL = .Cells(.Rows.Count, iCol).End(xlUp).Row
'ins TMP-Blatt kopieren, dann alles löschen
.Cells.Copy
TTmp.Range("A1").PasteSpecial xlPasteValues
Application.CutCopyMode = False
.Range(.Cells(lRowF, iCol), .Cells(lRowL, iCol)).EntireRow.ClearContents
End With
With T1
'die aktuellen "Namen" kopieren
lRowL = .Cells(.Rows.Count, iCol).End(xlUp).Row
.Range(.Cells(lRowF, iCol), .Cells(lRowL, iCol)).Copy
End With
With T2
'und ins T2 überteragen
.Cells(lRowF, iCol).PasteSpecial
Application.CutCopyMode = False
With .Range(.Cells(lRowF, iCol + 1), .Cells(lRowL, iColLast))
'alte Werte per SVERWEIS Formel wieder holen,
.FormulaR1C1 = "=VLOOKUP(RC1,TEMP!R1:R65536,COLUMN(R[-5]C),)"
'Fehlerwerte #NV eliminieren
.SpecialCells(xlCellTypeFormulas, 16).ClearContents
'Formeln überschreiben mit Werten
.Value = .Value
End With
End With
'Temporäres Sheet löschen, ohne nervige Rückfrage von Xl
Application.DisplayAlerts = False
TTmp.Delete
Application.DisplayAlerts = True
End Sub

Grüße,
Klaus M.vdT.

Beliebteste Forumthreads (12 Monate)

9 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

9
Beiträge zum Forumthread

Beiträge zu diesem Forumthread