Sub ertert()
Dim Fold As String, f As String
Dim sFlNames As String, t As String

If Right(ThisWorkbook.Path, 1) <> "\" Then Fold = ThisWorkbook.Path & "\" Else Fold = ThisWorkbook.Path
f = Dir(Fold & "*.txt", vbNormal)

Do While f <> ""
     If f <> ThisWorkbook.Name Then
         t = IIf(InStr(f, "("), Split(f, "(")(0), Split(f, ".")(0))
          
         If InStr(sFlNames, t) = 0 Then
             sFlNames = sFlNames & t & "~"
             ' не повторяющийся файл пишем в 1-й столбик
             Cells(Rows.Count, 1).End(xlUp)(2, 1).Value = f
         Else
             ' повторяющийся файл пишем во 2-й столбик
             Cells(Rows.Count, 2).End(xlUp)(2, 1).Value = f
         End If
     End If
     f = Dir()
Loop
End Sub

Sub FindDuplicateFiles()
      Dim d As Object, p As Long, n As String, k As Variant
      Set d = CreateObject("Scripting.Dictionary")
      n = Dir("C:\Temp\" & "*.txt") 'Вместо C:\Temp\ необходимо указать путь к папке с файлами.
      While n <> vbNullString
          n = Left(n, Len(n) - 4) 'Отсекаем расширение.
          p = InStrRev(n, "(")
          If p > 0 Then If IsNumeric(Mid(n, p + 1, 1)) Then n = Trim(Left(n, p - 1)) 'Отсекаем скобки с цифрами (если есть).
          If d.Exists(n) Then d(n) = 1& Else d.Add n, 0& 'Запоминаем имя файла, либо ставим пометку, что найден дубликат.
          n = Dir
      Wend
      For Each k In d
          If d(k) = 1& Then Debug.Print k & ".txt" 'Выводим дубликаты.
      Next k
End Sub