Функция VBA Regex

Я не эксперт по RegEx, так что вы можете попробовать альтернативу:

Function ExtractCap(Txt As String) As String
    Application.Volatile
    Dim i As Long

    For i = 1 To Len(Txt)
        Select Case Asc(Mid(Txt, i, 1))
            Case 65 To 90
               ExtractCap = ExtractCap & Mid(Txt, i, 1)
        End Select
    Next
End Function

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

Function ExtractCap(Txt As String) As String
    Application.Volatile
    ExtractCap = "UA" & Split(Txt, ":")(3)
End Function

Ваш RegEx работает так:

Function ExtractCap(Txt As String) As String

    Application.Volatile
    Dim xRegEx As Object
    Set xRegEx = CreateObject("VBScript.RegExp")

    With xRegEx
        .Pattern = "[^A-Z]"
        .Global = True
        .MultiLine = False
        ExtractCap = .Replace(Txt, vbNullString)
    End With

    If Txt = ExtractCap Then ExtractCap = "1WO"

End Function

Public Sub TestMe()
    Debug.Print ExtractCap("User:399595:Account:ETH:balance")
End Sub

В вашем коде было 2 ошибки, остановившие выполнение:

• xRegEx был установлен на Nothing, а затем его попросили предоставить значение;
• чек If xRegEx.Pattern = "[^A-Z]" на самом деле мало что значит для VBA. Например, вы устанавливаете Pattern и делаете из него условие. Если вы хотите узнать, существует ли шаблон в RegEx, вам следует сравнить две строки - до и после выполнения шаблона.

Ваша проблема решается легко.

Во-первых, я предположил, что 1WO может появляться в вашей строке не более одного раза.

Исходя из этого предположения, логика следующая:

Определите функцию, которая извлекает все заглавные буквы из строк.

Теперь в функции main вы сначала разделяете строку, используя 1WO в качестве разделителя. Теперь передайте каждую строку (после разделения) функции, получите все заглавные буквы из этих строк и снова объедините их с 1WO на своем месте.

Option Explicit

Public Function Extract(str As String) As String
Dim s As Variant
For Each s In Split(str, "1WO")
    'append extracted caps with 1WO at the end
    Extract = Extract & ExtractCaps(s) & "1WO"
Next
'delete lest 1WO from result
Extract = Left(Extract, Len(Extract) - 3)

End Function

Function ExtractCaps(str As Variant) As String
Dim i As Long, char As String
For i = 1 To Len(str)
    char = Mid(str, i, 1)
    If Asc(char) > 64 And Asc(char) < 91 And char = UCase(char) Then
        ExtractCaps = ExtractCaps & char
    End If
Next
End Function

Если вы поместите этот код во вставленный Module, вы можете использовать его на листе в формуле: =Extract(A1).