Пытаюсь извлечь данные из фигурных скобок, но не работает

Попробуй это:

Sub Collapse()
    Dim uRng As Range, cel As Range
    Dim comps As Variant, comp As Variant, r As Variant, v As Variant
    Dim d As Dictionary '~~> Early bind, for Late bind use commented line
    'Dim d As Object
    Dim a As String

    With Sheet1 '~~> Sheet that contains your data
        Set uRng = .Range("F1", .Range("F" & .Rows.Count).End(xlUp))
    End With

    Set d = CreateObject("Scripting.Dictionary")
    With d
        For Each cel In uRng
            a = Replace(cel.Offset(0, -3), "{", "}")
            comps = Split(a, "}")
            Debug.Print UBound(comps)
            For Each comp In comps
                If InStr(comp, "Computer") <> 0 _
                And Len(Trim(comp)) <= 10 Then '~~> I assumed max Comp# is 99
                    If Not .Exists(cel) Then
                        .Add cel, comp
                    Else
                        If IsArray(.Item(cel)) Then
                            r = .Item(cel)
                            ReDim Preserve r(UBound(r) + 1)
                            r(UBound(r)) = comp
                            .Item(cel) = r
                        Else
                            r = Array(.Item(cel), comp)
                            .Item(cel) = r
                        End If
                    End If
                End If
            Next
        Next
    End With

    For Each v In d.Keys
        With Sheet2 '~~> sheet you want to write your data to
            If IsArray(d.Item(v)) Then
                .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .Resize(UBound(d.Item(v)) + 1) = v
                .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) _
                    .Resize(UBound(d.Item(v)) + 1) = Application.Transpose(d.Item(v))
            Else
                .Range("A" & .Rows.Count).End(xlUp).Offset(1, 0) = v
                .Range("B" & .Rows.Count).End(xlUp).Offset(1, 0) = d.Item(v)
            End If
        End With
    Next
    Set d = Nothing

End Sub

В приведенном выше коде используется Функция замены и разделения для передачи строки в массив.

a = Replace(cel.Offset(0, -3), "{", "}") '~~> standardize delimiter
comps = Split(a, "}") '~~> split using standard delimiter

Затем информация передается в объект словаря с использованием пользователя в качестве ключа и компьютеров в качестве элементов.
Мы фильтруем элементы, передаваемые в словарь, с помощью функций Instr и Len.

If InStr(comp, "Computer") <> 0 _
And Len(Trim(comp)) <= 10 Then

Как я уже говорил, я предположил, что ваш максимальный номер компьютера равен 99.
В противном случае измените 10 на любую длину, которую вам нужно проверить.
Наконец, мы возвращаем словарную информацию на целевой рабочий лист.
Примечание. : Вам нужно добавить ссылку на Microsoft Scripting Runtime, если вы предпочитаете раннее связывание

Результат: я попробовал это на небольшой выборке данных, основанной на том, как я вижу это у вас, SS.

Итак, если у вас есть эти данные на Листе 1:

Будет выводить данные в Sheet2 следующим образом:

Я использую пользовательскую функцию синтаксического анализа для этого типа операций:

Sub CopyConditional()
  ' some detail left out
  Dim iRow&, Usern$, Computer$, Computers$
  For iRow = ' firstrow To lastrow
    Usern = Sheets("Emails").Cells(iRow, "F")
    Computers = Sheets("Emails").Cells(iRow, "C")
    Do
      Computer = zParse(Computers) ' gets one computer
      If Computer = "" Then Exit Do
      ' Store Computer and Usern
    Loop
  Next iRow
End Sub

Function zParse$(Haystack$) ' find all {..}
  Static iPosL& '
  Dim iPosR&
  If iPosL = 0 Then iPosL = 1
  iPosL = InStr(iPosL, Haystack, "{") ' Left
  If iPosL = 0 Then Exit Function ' no more
  iPosR = InStr(iPosL, Haystack, "}") ' Right
  If iPosR = 0 Then MsgBox "No matching }": Stop
  zParse = Mid$(Haystack, iPosL + 1, iPosR - iPosL - 1)
  iPosL = iPosR
End Function

1) Используйте функцию Mid, чтобы удалить первый символ:

str = "{Computer1"
str = Mid(str,2)

теперь ул = "Компьютер1"

2) Вы можете использовать функцию Split, чтобы разделить их и объединить с функцией Mid выше.

str = "{Computer1}{Computer2}"
splt = Split(str,"}")
for a = 0 to Ubound(splt)
     result = Mid(splt(a),2)
next a

3) Добавьте условный оператор в вышеуказанный цикл

str = "{Computer1}{Computer2}"
splt = Split(str,"}")
for a = 0 to Ubound(splt)
     if Left(splt(a),1) = "{" then result = Mid(splt(a),2)
next a

Используйте этот цикл и отправьте каждый результат в нужную ячейку (в цикле for-next), и все будет хорошо.