Sub
optimiert()
Dim
wb
As
Workbook, ws
As
Worksheet, wbZwei
As
Workbook, wsZwei
As
Worksheet
Dim
lSpalte&, strFile$, I&, sWert, Zugriffe&
Dim
rngBereich
As
Range
Dim
Arbeitsbereich
As
Range, Werte
lSpalte = 1
strFile = Application.GetOpenFilename
Set
wb = ThisWorkbook
Set
ws = wb.Sheets(1)
Set
wbZwei = Workbooks.Open(Filename:=strFile)
Set
wsZwei = wbZwei.Sheets(3)
With
ws
Set
Arbeitsbereich = .Range(.Cells(10, 1), .Cells(.Rows.Count, 1).
End
(xlUp))
End
With
Werte = Arbeitsbereich.Value
For
I = 1
To
UBound(Werte)
sWert = Trim(Werte(I, lSpalte))
If
sWert <>
""
Then
Set
rngBereich = wsZwei.Cells.Find(What:=sWert, LookIn:=xlValues, LookAt:=xlPart)
If
Not
rngBereich
Is
Nothing
Then
Zugriffe = Zugriffe + 1
With
ws
.Cells(I, lSpalte + 4).Font.ColorIndex = 3
.Cells(I, lSpalte + 5).Value =
"JA"
.Cells(I, lSpalte + 5).Font.ColorIndex = 1
End
With
End
If
Else
Zugriffe = Zugriffe + 1
ws.Cells(I, lSpalte + 5).Value =
"NEIN"
End
If
Next
I
MsgBox
"Schreiben in Zellen: "
& Zugriffe &
" Zugriffe."
, vbInformation
MsgBox
"Suchbereich: "
& wsZwei.UsedRange.Address
End
Sub