|
Hier ein paar Kommentare:
Option Explicit
Sub DateienVergleichen()
Dim RNG As Range, Dat1, Dat2, R&, I&, Enthalten As Boolean, errCount& 'definition der verwendeten variablen (&=long)
Application.ScreenUpdating = False 'bildschirm nicht updaten (kein flackern, schnellere berechnung beim färben)
Dat1 = Workbooks("File1.xls").Sheets(1).Range("A7:a100").Value 'daten an erstes array übergeben
Set RNG = Workbooks("File2.xls").Sheets(1).Range("A7:a100") 'range-object für file 2 erstellen
Dat2 = RNG.Value 'daten an zweites array übergeben
RNG.Interior.ColorIndex = xlNone 'farben in file 2 auf standard zurücksetzen
For R = 1 To UBound(Dat1) 'anzahl zeilen file 1
For I = 1 To UBound(Dat2) 'anzahl zeile file 2
If Dat1(R, 1) = Dat2(I, 1) Then 'wert in file 2 färben wenn wert aus file 1 mit wert aus file 2 übereinstimmt
RNG(I, 1).Interior.ColorIndex = 6 'farbe gelb
Enthalten = True 'zahl aus file 1 ist in file 2 enthalten
End If
Next
If Not Enthalten Then 'nur die ersten 10 fehlermeldungen anzeigen...
If errCount < 10 Then MsgBox Dat1(R, 1) & "(" & RNG(R, 1).Address & ") - Nicht in File 2 enthalten!", vbCritical 'Fehlermeldung ausgeben
errCount = errCount + 1 'anzahl der fehlermeldungen
Else
Enthalten = False 'wieder auf falsch setzen
End If
Next
Application.ScreenUpdating = True 'anzeige updaten
End Sub
Beide Arbeitsmappen müssen vorher manuell geöffnet werden...
|