Sub Test()
  Dim a, d, k, ks
  Set d = GetLastFiles
  If d.Count Then
    ks = d.keys
    For Each k In ks: a = d(k): Debug.Print a(2): Next
  End If
End Sub

Function GetLastFiles()
  Dim a, b(), d, f, fs0, fn$, fs, fso, i&, k$, sfs
  fn = GetDataFolder("Выберите папку, содержащую папки с файлами")
  If fn = "" Then Exit Function
  Set fso = CreateObject("Scripting.FileSystemObject")
  Set d = CreateObject("Scripting.Dictionary")
  Set fs0 = fso.getfolder(fn)
  For Each fs In fs0.subfolders
    For Each f In fs.Files
      a = Split(f.Name, "-")
      If UBound(a) > 0 And UBound(a) < 3 Then
        If UBound(a) = 1 Then k = a(0) & a(1): i = 0
        If UBound(a) = 2 Then k = a(0) & a(2): i = Val(a(1))
        If d.exists(k) Then b = d(k) Else ReDim b(1 To 2)
        If i > b(1) Then b(1) = i: b(2) = f.Path: d(k) = b
      End If
    Next
  Next
  Set GetLastFiles = d
End Function

Function GetDataFolder$(tit$, Optional Pth$ = "")
  With Application.FileDialog(msoFileDialogFolderPicker)
    If Pth = "" Then Pth = ThisWorkbook.Path
    .ButtonName = "Выбрать": .Title = tit: .InitialFileName = Pth
    If .Show <> -1 Then Exit Function
    GetDataFolder = .SelectedItems(1)
  End With
End Function

        If d.Exists(k) Then b = d(k) _
        Else ReDim b(1 To 2): b(1) = -1: b(2) = f.Path
        If i > b(1) Then b(1) = i: d(k) = b

Sub ClearLowIndex()
  Dim a, b, d, i&, k, ks, r&, s
  Set d = CreateObject("Scripting.Dictionary"): a = [a1].CurrentRegion
  For r = 2 To UBound(a)
    s = Split(a(r, 1), "-")
    If UBound(s) > 0 And UBound(s) < 3 Then
      If UBound(s) = 1 Then k = s(0) & s(1): i = 0
      If UBound(s) = 2 Then k = s(0) & s(2): i = Val(s(1))
      If d.Exists(k) Then b = d(k) _
      Else ReDim b(1 To 2): b(1) = -1: b(2) = a(r, 1)
      If i > b(1) Then b(1) = i: d(k) = b
    End If
  Next
  If d.Count Then
    ks = d.keys: [c:c].ClearContents: r = 1
    For Each k In ks: a = d(k): r = r + 1: Cells(r, 3) = a(2): Next
  End If
End Sub