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....