Zellen vergleichen und Bereiche verschieben
22.01.2009 22:44:29
Boulbadaoui
ich habe 2 Tabellen je 3 Spalte und mehrere Zeilen
Spalte A in Tabelle1(Bzw. in Tabelle 2) ab Zeile2 beinhalten PLZ Werte.
Die Aufgabe ist:
vergleichen Werten in A von Tabelle1 mit Werten in A von Tabelle2, falls die werte gleich sind, dann nichts machen, sonst komplette Bereich(A:C) in Tabelle2 um eine Zeile runter verschieben.
und dann geht die Überprüfung weiter bis letzte Zeile in Tabelle1
habe folgendes versucht aber es wird nur die Zelle An um eine Zeile runter verschoben!
__________________________________________________________
Sub Übereinstimmungen_finden()
Dim Letzte_Zeile As Long, Wiederholungen As Long, _
Suchbegriff As Range, Addresse As String, Mindestens_ein_Wert As Long
Application.ScreenUpdating = False
Letzte_Zeile = Range("A65536").End(xlUp).Row
For Wiederholungen = 2 To Letzte_Zeile
Mindestens_ein_Wert = 0
With Worksheets(1).Range(Cells(1, 1), Cells(Letzte_Zeile, 1))
Set Suchbegriff = .Find(What:=Cells(Wiederholungen, 1), LookIn:=xlValues)
If Not Suchbegriff Is Nothing Then
Addresse = Suchbegriff.Address
Do
Mindestens_ein_Wert = Mindestens_ein_Wert + 1
If Mindestens_ein_Wert > 1 Then
Suchbegriff.Rows.ClearContents
End If
Set Suchbegriff = .FindNext(Suchbegriff)
Loop While Not Suchbegriff Is Nothing And Suchbegriff.Address Addresse
End If
End With
Next
Range(Cells(2, 1), Cells(Letzte_Zeile, 1)). _
SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
____________________________________________________________________
haben vielleicht ein Tipp für mich! Danke im Voraus
Anzeige