AW: Prima!
30.01.2004 19:23:50
Roland Hochhäuser
Hallo Joachim,
danach ist für mich Wochenende!
Option Explicit
Sub NummernVergleichenUndLöschen()
Dim Blatt As Integer, i As Integer, j As Integer, k As Integer, l As Integer
Dim ws As Worksheet, Quelle As Worksheet, Ziel As Workbook, strfile As String
strfile = ThisWorkbook.Path & "\empfaengerliste.xls"
On Error Resume Next
Workbooks.Open (strfile)
Set Quelle = Workbooks("sperrliste.xls").Worksheets(1)
Set Ziel = Workbooks("empfaengerliste.xls")
For Blatt = 1 To Ziel.Sheets.Count
If MsgBox("Sollen aus dem Blatt ""empfaengerliste"" " & Ziel.Sheets(Blatt).Name & " doppelte Nummern gelöscht werden?", vbYesNo) = 6 Then
Set ws = Workbooks("empfaengerliste.xls").Worksheets(Blatt)
k = 0
For i = ws.Range("A65536").End(xlUp).Row To 1 Step -1
For j = Ziel.Worksheets(Blatt).Range("A65536").End(xlUp).Row To 1 Step -1
If Ziel.Worksheets(Blatt).Range("A" & j).Value = Quelle.Range("A" & i).Value Then
Ziel.Worksheets(Blatt).Rows(j).Delete
k = k + 1
Else
End If
Next j
Next i
MsgBox k & " Nummern wurden in Blatt " & Ziel.Sheets(Blatt).Name & " gelöscht."
l = l + k
End If
Next Blatt
MsgBox "Insgesamt " & l & " Nummern wurden aus " & Ziel.Sheets.Count & " Blättern gelöscht"
Set Ziel = Nothing
Set Quelle = Nothing
Set ws = Nothing
End Sub
. . . Was müsste ich ändern, um den Abgleich immer nur für das aktive Tabellenblatt zu machen
Nimm die erste For-Next-Schleife raus, dann werden die Blätter nicht mehr durchgegangen.
Ein schönes Wochenende
Roland