AW: 2 Spalten vergleichen
06.07.2020 10:25:11
Werner
Hallo,
falls du nochmal rein schaust. Hier der Code nochmal.
Hatte da am Anfang noch Application.CutCopyMode = False, das sollte eigentlich Application.ScreenUpdating = Fals sein.
Jetzt auch mit Änderung der Schriftgröße in Tabelle2 auf 10.
Option Explicit
Public Sub aaa()
Dim i As Long, loLetzte As Long, loLetzte1 As Long
Dim loSpalte As Long, raDelete As Range
Application.ScreenUpdating = False
With Worksheets("Tabelle2")
.Columns("A:B").ClearContents
loLetzte = .Cells(.Rows.Count, "A").End(xlUp).Row
loLetzte1 = .Cells(.Rows.Count, "C").End(xlUp).Row
loSpalte = .Cells(4, .Columns.Count).End(xlToLeft).Offset(, 1).Column
If loLetzte1 > loLetzte Then loLetzte = loLetzte1
With Worksheets("Tabelle1")
.Range("A4:B30").Copy Worksheets("Tabelle2").Range("A1")
End With
With .Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte))
.FormulaLocal = "=$A2&$B2"
.Value = .Value
End With
With .Range(.Cells(2, loSpalte + 1), .Cells(loLetzte, loSpalte + 1))
.FormulaLocal = "=$C2&$D2"
.Value = .Value
End With
For i = 2 To loLetzte
If WorksheetFunction.CountIf(.Columns(loSpalte + 1), .Cells(i, loSpalte)) > 0 Then
If raDelete Is Nothing Then
Set raDelete = .Cells(i, "A").Resize(, 2)
Else
Set raDelete = Union(raDelete, .Cells(i, "A").Resize(, 2))
End If
End If
Next i
If Not raDelete Is Nothing Then
raDelete.Delete shift:=xlUp
End If
.Range(.Cells(1, loSpalte), .Cells(1, loSpalte + 1)).EntireColumn.ClearContents
.Columns("A:B").Font.Size = 10
End With
Set raDelete = Nothing
End Sub
Gruß Werner