for-loop too slow

Dear Pros,


I have a for loop for a task that a VLOOKUP would do. I just needed all the matches so the for loop. It served its task but it got too slow.
Can somebody help me turning it into an Array-Macro?

Sub suchenMitVBA()


Dim lastrow As Long
Dim LastRow2 As Long
Dim i As Long
Dim M As Long
Dim Article As String

    With ActiveSheet
        '
        lastrow = ActiveWorkbook.Worksheets("Übertrag vom Suchfile").Cells(Rows.Count, 1).End(xlUp).Row

        LastRow2 = .Cells(Rows.Count, 1).End(xlUp).Row
        
        .Range("c2").EntireColumn.ClearContents

        'Outer loop to go through column E values
        For M = 2 To LastRow2
            Article = Range("a" & M).Value
            'Inner loop to run through column A values
            For i = 2 To lastrow
                If VBA.StrComp(ActiveWorkbook.Worksheets("Übertrag vom Suchfile").Range("a" & i).Value, Article, vbTextCompare) = 0 Then
                    .Range("c" & M).Value = .Range("c" & M).Value & ActiveWorkbook.Worksheets("Übertrag vom Suchfile").Range("B" & i).Value
                End If

            Next i
        Next M
    End With
End Sub

I also attached the file with a short description.


Thank you indeed for your help!!


Best regards

Peter

How about

Sub peterschien()
   Dim Ary As Variant, Nary As Variant
   Dim i As Long
   Dim Dic As Object
   
   Set Dic = CreateObject("scripting.dictionary")
   Dic.comparemode = 1
   With Sheets("Übertrag vom Suchfile")
      Ary = .Range("A2:B" & .Range("A" & Rows.Count).End(xlUp).Row).Value2
   End With
   For i = 1 To UBound(Ary)
      Dic(Ary(i, 1)) = Dic(Ary(i, 1)) & Ary(i, 2)
   Next i
   Ary = Range("A2", Range("A" & Rows.Count).End(xlUp)).Value2
   ReDim Nary(1 To UBound(Ary), 1 To 1)
   For i = 1 To UBound(Ary)
      If Dic.exists(Ary(i, 1)) Then Nary(i, 1) = Dic(Ary(i, 1))
   Next i
   Range("C2").Resize(UBound(Nary)).Value = Nary
   
End Sub