在Excel中拆分大写单词并插入定界符

时间:2018-07-17 08:07:05

标签: excel vba excel-vba

我有这个字符串:

RugbyFunny RugbyGirls RugbyBoys RugbyWomens Rugby

基本上,我想用大写字母将单词分开,并放置一个分隔符,例如;

我发现一个有用的VBA功能可以完成部分工作:

Function splitbycaps(inputstr As String) As String
    Dim i As Long
    Dim temp As String

    If inputstr = vbNullString Then
        splitbycaps = temp
        Exit Function
    Else
        temp = inputstr
        For i = 1 To Len(temp)
            If Mid(temp, i, 1) = UCase(Mid(temp, i, 1)) Then
                If i <> 1 Then
                    temp = Left(temp, i - 1) + " " + Right(temp, Len(temp) - i + 1)
                    i = i + 1
                End If
            End If
        Next i
        splitbycaps = temp
    End If
End Function

如何在每个单词之间添加分隔符?我想产生这样的结果:

Rugby;Funny Rugby;Girls Rugby;Boys Rugby;Womens Rugby;

在此先感谢您的帮助!

3 个答案:

答案 0 :(得分:3)

将功能更改为此:

Function SplitByCaps(InputStr As String) As String
    Dim i As Long
    Dim temp As String

    If InputStr = vbNullString Then
        SplitByCaps = temp
        Exit Function
    Else
        temp = InputStr
        Do While i < Len(temp)
            i = i + 1
            If Mid(temp, i, 1) <> LCase(Mid(temp, i, 1)) Then
                If i <> 1 Then
                    If Mid(temp, i - 1, 1) <> " " Then
                        temp = Left(temp, i - 1) & ";" & Right(temp, Len(temp) - i + 1)
                        i = i + 1
                    End If
                End If
            End If
            DoEvents
        Loop
        SplitByCaps = temp
    End If
End Function

编辑:将其更改为Do的{​​{1}}循环,正如@Vityata指出的那样。

For

答案 1 :(得分:1)

根据ASCII值进行比较

For i = 1 To Len(TEMP)
    If i <> 1 Then
        If Asc(Mid(TEMP, i, 1)) >= 65 And Asc(Mid(TEMP, i, 1)) <= 90 Then
            TEMP = Left(TEMP, i - 1) + ";" + Right(TEMP, Len(TEMP) - i + 1)
            i = i + 1
        End If
    End If
Next i

答案 2 :(得分:1)

首先,您需要找到字符串的所有位置,其中:

  • 字符是一个大写字母
  • 字符实际上是字母
  • 字符前没有空格

然后,这些职位可以保存在集合中。此函数可以查找下一个大写位置,如果没有,则返回-1

Public Function NextUpperCasePosition(str As String, marker As Long) As Long

    Dim i As Long

    Dim isUpper As Boolean
    Dim isLetter As Boolean
    Dim noSpaceBefore As Boolean

    If marker = 1 Then
        NextUpperCasePosition = 1
        Exit Function
    End If

    For i = marker To Len(str)

        noSpaceBefore = CBool(Len(Trim(Mid(str, i - 1, 1))) > 0)
        isUpper = CBool(Mid(str, i, 1) = UCase(Mid(str, i, 1)))
        isLetter = CBool(LCase(Mid(str, i, 1)) <> UCase(Mid(str, i, 1)))

        If isUpper And isLetter And noSpaceBefore Then
            NextUpperCasePosition = i
            Exit Function
        End If
    Next i

    NextUpperCasePosition = -1

End Function

一旦能够找到位置并将其添加到位置集合中,就可以遍历该集合并将基于这些数字的字符串拆分为一个数组。数组准备好后,Join(arr,“;”)可以正常工作以生成所需的字符串:

Public Sub SplitByUpperCase()

    Dim str As String
    str = "KRugbyFunny RugbyGirls RugbyBoys RugbyWomens Rugby K TB"

    Dim i As Long
    Dim result As New Collection
    Dim nextPosition As Long: nextPosition = 1

    For i = 1 To Len(str) Step 1
        If i = nextPosition Then
            nextPosition = NextUpperCasePosition(str, nextPosition)
            If nextPosition >= 1 Then result.Add (nextPosition)
            nextPosition = nextPosition + 1
        End If
    Next i

    Dim resultArr As Variant
    ReDim resultArr(result.Count - 1)
    Dim lenOfWord As Long

    For i = 1 To result.Count
        If i = result.Count Then
            lenOfWord = Len(str) - result(i) + 1
        Else
            lenOfWord = result(i + 1) - result(i)
        End If
        resultArr(i - 1) = Mid(str, result(i), lenOfWord)
    Next i

    Debug.Print Join(resultArr, "; ")

End Sub