Das erklärt Alles, du bauftragst die Excel Suchfunktion 10000 mal in 1.000.000 * 15.000 Zellen nach einem Wert zu suchen. Die Excel Suchfunktion rechnet zwar recht schnell und dürfte den Bereich auf die UsedRange eindämmen, aber damit kommst du immernoch auf 10000*wsZweiZeilenAnzahl*Spaltenanzahl Zellen die durchsucht werden müssen. Hinzu kommen noch langsame Verweise auf Zellen anstatt Zugriffen auf ein Array...
Ich hab das mal ein wenig überarbeitet. Das Wesentliche Problem ist aber der Suchbereich in wsZwei. Den musst du versuchen einzudämmen.
Versuchs mal mit folgendem Makro und schreib die Meldungen hier auf:
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
'set
lSpalte = 1
strFile = Application.GetOpenFilename
Set wb = ThisWorkbook
Set ws = wb.Sheets(1) 'Preis
Set wbZwei = Workbooks.Open(Filename:=strFile)
Set wsZwei = wbZwei.Sheets(3) '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
Cancel=True musst du wieder einabauen wenn du das in deine Ereignisprozedur einbauen willst....
|