|
Hi,
< dass aus der Liste NEU alle Datensätze gelöscht werden, die BESTAND enthält
dann eben zu Fuß mit Stringvergleich ;-)
Option Explicit
Sub ListeNeuBereinigen()
Rem in NEU verbleibt was in BESTAND nicht enthalten
Const fRow = 3 'Datenbeginn
Dim ShN As Worksheet 'NEU
Dim ShB As Worksheet 'BESTAND
Dim nRng As Range, c As Range, k As Range
Dim lRow As Long, y As Long
Dim x As Integer
Dim aStr As String, nStr As String, bstr As String
Dim Spalten(1 To 3) As Long
Spalten(1) = 1 ' Spaltennummer rechts von = Vorname
Spalten(2) = 4 ' ditto PLZ
Spalten(3) = 6 ' ditto Telefon
Set ShN = Sheets("NEU")
Set ShB = Sheets("BESTAND")
lRow = ShN.Cells.Find("*", [a1], , , xlByRows, xlPrevious).Row
Set nRng = Range(ShN.Cells(fRow, 1), ShN.Cells(lRow, 1))
Application.ScreenUpdating = False
For Each c In nRng
nStr = c.Value
For x = 1 To 3
nStr = nStr & c.Offset(0, Spalten(x)).Value
Next x
With ShB.Columns(1)
Set k = .Find(c.Value)
If Not k Is Nothing Then
aStr = k.Address
Do
bstr = k.Value
For x = 1 To 3
bstr = bstr & k.Offset(0, Spalten(x)).Value
Next x
If nStr = bstr Then c.Value = ""
Set k = .FindNext(k)
Loop While Not k Is Nothing And k.Address <> aStr
End If
End With
Next c
With ShN
For y = lRow To fRow Step -1
If .Cells(y, 1).Value = "" Then Rows(y).Delete
Next y
End With
Application.ScreenUpdating = True
End Sub
< und DANACH die Daten aus BESTAND komplett gelöscht werden ? ? ?
|