still very long time to run
Sub tes()
Dim i&, ii&, x, txt$, d As Object
Set d = CreateObject("scripting.dictionary")
x = [a1:ac100000].Value
 
 For i = 1 To UBound(x)
    For ii = 1 To UBound(x, 2)
      txt = IIf(txt = "", x(i, ii), txt & "," & x(i, ii))
    Next ii
   d(txt) = x(i, 1)
 Next i
    txt = ""
End Sub