我会使用正则表达式来替换任何空格和逗号的组合。

Sub Test()

Dim str As String: str = "STRING_22   ,,,,,STRING_1 ,  ,  ,,,,,STRING_333   STRING_22 STRING_4444"
Debug.Print RegexReplace(str, "[\s,]+", ",")

End Sub

Function RegexReplace(x_in, pat, repl) As String

With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = pat
    RegexReplace = .Replace(x_in, repl)
End With

End Function

只是为了寻找替代品：

B1中的公式：

=TEXTJOIN(",",,TEXTSPLIT(A1,{" ",","}))

下面的函数将把输入的字符串分割成多个片段（单词），使用逗号作为分隔符。当输入的字符串有多个逗号时，将会导致空单词。
拆分后，函数循环遍历所有单词，修剪它们（去掉开头和结尾的空格）并将它们粘在一起。
我已经将其实现为函数，您可以将其用作UDF：如果输入字符串在B2中，则将=String_adaption(B2)作为Formula写入任意单元格。

Function String_adaption(s As String) As String
    ' Remove duplicate Commas and Leading and Trailing Blanks from words
    Dim words() As String, i As Long
    words = Split(s, ",")
    For i = 0 To UBound(words)
        Dim word As String
        word = Trim(words(i))
        If word <> "" Then
            String_adaption = String_adaption & IIf(String_adaption = "", "", ",") & word
        End If
    Next i
End Function

P.S.：几乎可以肯定，这可以用一些神奇的正则表达式来完成，但我不是这方面的Maven。

如果您有最新版本的Excel，您可以使用简单的工作表函数来拆分space和comma上的字符串;然后使用comma分隔符将其重新组合在一起，并忽略空格 （我刚刚注意到@JvdV之前发布了相同的公式解决方案）：

=TEXTJOIN(",",TRUE,TEXTSPLIT(A1,{" ",","}))

在VBA中，可以使用类似的算法，使用ArrayList对象收集非空结果。

Option Explicit

Function commaOnly(s As String) As String
    Dim v, w, x, y
    Dim al As Object
    
Set al = CreateObject("System.Collections.ArrayList")

v = Split(s, " ")
For Each w In v
    x = Split(w, ",")
    For Each y In x
        If y <> "" Then al.Add y
    Next y
Next w

commaOnly = Join(al.toarray, ",")
    
End Function

这将保留较小字符串中的空格。

Option Explicit
Sub demo()
     Const s = "STRING 22,,,,   ,,STRING  1,,,,  ,,STRING  333 , , ,  STRING_22 STRING_44"
     Debug.Print Cleanup(s)
End Sub

Function Cleanup(s As String) As String

    Const SEP = ","
    Dim regex, m, sOut As String, i As Long, ar()
    Set regex = CreateObject("vbscript.regexp")
    With regex
        .Global = True
        .MultiLine = False
        .IgnoreCase = True
        .Pattern = "([^,]+)(?:[ ,]*)"
    End With
    
    If regex.Test(s) Then
    
        Set m = regex.Execute(s)
        ReDim ar(0 To m.Count - 1)
        For i = 0 To UBound(ar)
           ar(i) = Trim(m(i).submatches(0))
        Next
        
    End If
    Cleanup = Join(ar, SEP)

End Function

代码类别方法

为了完整起见，也为了展示其他方式 “通向罗马”，我想演示一种方法，允许将字符串输入分组为五个代码类别，以便通过巧妙的匹配提取字母数字 （参见[B]函数getCats()）：
要满足OP中的要求，请使用以下步骤：

• 1)如果为空或仅为空白则移除逗号分隔的标记（可选），
• 2)将字符分组为代码类别，
• 3) check cat返回字母数字的代码，包括偶数重音字母或变音字母以及[ -，.+_]等字符

Function AlphaNum(ByVal s As String, _
                  Optional IgnoreEmpty As Boolean = True, _
                  Optional info As Boolean = False) As String
'Site:  https://stackoverflow.com/questions/15723672/how-to-remove-all-non-alphanumeric-characters-from-a-string-except-period-and-sp/74679416#74679416
'Auth.: https://stackoverflow.com/users/6460297/t-m
'Date:  2023-01-12
'1) remove comma separated tokens if empty or only blanks (s passed as byRef argument)
    If IgnoreEmpty Then RemoveEmpty s                    ' << [A] RemoveEmpty
'2) group characters into code categories
    Dim catCodes: catCodes = getCats(s, info)            ' << [B] getCats()
'3) check catCodes and return alpha nums plus chars like [ -,.+_]
    Dim i As Long, ii As Long
    For i = 1 To UBound(catCodes)
        ' get current character
        Dim curr As String: curr = Mid$(s, i, 1)
        Dim okay As Boolean: okay = False
        Select Case catCodes(i)
        '   AlphaNum: cat.4=digits, cat.5=alpha letters
            Case Is >= 4: okay = True
        '   Category 2: allow only space, comma, minus
            Case 2: If InStr(" -,", curr) <> 0 Then okay = True
        '   Category 3: allow only point, plus, underline
            Case 3: If InStr(".+_", curr) <> 0 Then okay = True
        End Select
        If okay Then ii = ii + 1: catCodes(ii) = curr   ' increment counter
    Next i
    ReDim Preserve catCodes(1 To ii)
    AlphaNum = Join(catCodes, vbNullString)
End Function

• 注意：除了Case 2中的If InStr(" -,", curr) <> 0 Then，您也可以编写If curr like "[ -,]" Then。类似于Case 3：-）*
  [A]帮助程序RemoveEmpty
• 可选清理，如果为空或仅包含空格，则删除逗号分隔的标记：*

Sub RemoveEmpty(ByRef s As String)
'Purp:  remove comma separated tokens if empty or only blanks
    Const DEL = "$DEL$"             ' temporary deletion marker
    Dim i As Long
    Dim tmp: tmp = Split(s, ",")
    For i = LBound(tmp) To UBound(tmp)
        tmp(i) = IIf(Len(Trim(tmp(i))) = 0, DEL, Trim(tmp(i)))
    Next i
    tmp = Filter(tmp, DEL, False)   ' remove marked elements
    s = Join(tmp, ",")
End Sub

[B]帮助程序函数getCats()

• 一种将字符分为五个代码类别的巧妙方法，从而构建***基本逻辑**以供进一步分析：

Function getCats(s, Optional info As Boolean = False)
'Purp.: group characters into five code categories
'Auth.: https://stackoverflow.com/users/6460297/t-m
'Site:  https://stackoverflow.com/questions/15723672/how-to-remove-all-non-alphanumeric-characters-from-a-string-except-period-and-sp/74679416#74679416
'Note:  Cat.: including:
'       1 ~~> apostrophe '
'       2 ~~> space, comma, minus  etc
'       3 ~~> point separ., plus   etc
'       4 ~~> digits 0..9
'       5 ~~> alpha (even including accented or diacritic letters!)
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
'a) get array of single characters
    Const CATEG As String = "' - . 0 A"      'define group starters (case indep.)
    Dim arr:   arr = Char2Arr(s)             ' << [C] Char2Arr()
    Dim chars: chars = Split(CATEG)
'b) return codes per array element
    getCats = Application.Match(arr, chars)  'No 3rd zero-argument!!
'c) display in immediate window (optionally)
    If info Then Debug.Print Join(arr, "|") & vbNewLine & Join(getCats, "|")
End Function

[C]帮助程序函数Char2Arr

• 将每个字符串字符分配给一个数组：*

Function Char2Arr(ByVal s As String)
'Purp.: assign single characters to array
    s = StrConv(s, vbUnicode)
    Char2Arr = Split(s, vbNullChar, Len(s) \ 2)
End Function