从下划线分隔的字符串中提取PascalCase字符串和数字

时间:2020-08-11 19:45:50

标签: vba outlook

给定的字符串格式为FirstnameLastname_ABC_11111_500 我需要提取名字,姓氏和500,而忽略其余部分(ABC,随机数和下划线),并将其提取为以下格式的字符串:“名字姓氏/ 500”

不确定在VBA脚本中解决此问题的最佳方法是什么。

1 个答案:

答案 0 :(得分:0)

我想这会相当不错。我添加了一些安全网,但是可以进一步改善它。我已经将其编码为一个函数,但是,当然,您可以根据需要将其添加到代码中。

此代码使用VBA.Split作为分隔符将输入拆分(_)成段,然后逐个字符解析第一部分字符,检测大写字母并在其前添加空格。我的全名由6个单词组成,因此我已经做到了,因此此代码可与所需的尽可能多的单词兼容。 ;)

最后,代码检测输入字符串中是否确实有更多段,并将最后一个段添加到结果字符串中。

Option Explicit

Public Function stringExtractor(givenString As String) As String
    
    If VBA.Len(givenString) > 0 Then    ' If the user enters an empty string, this prevents execution errors
    
        Dim stringParts() As String
        Dim finalResult As String
        Dim fullName As String
        Dim i As Integer
        Dim currentChar As String
        Dim lastPart As String
        Dim partCount As Integer
        
        stringParts = VBA.Split(givenString, "_")   ' Gets the original string split into its components, and loaded into stringParts
        
        fullName = stringParts(0)   ' Gets the name part into a variable of its own
        finalResult = ""
        i = 1
        
        Do Until i > VBA.Len(fullName)  ' Loops through all the name, to start loading it into the finalResult
        
            currentChar = VBA.Mid(fullName, i, 1)
            
            If currentChar = VBA.UCase(currentChar) And VBA.Len(finalResult) <> 0 Then ' If we find an uppercase character and finalResult is not empty (this is not the first word)
                finalResult = finalResult & " " & currentChar                           ' we are entering a new word, and we have to enter both the found character and a blank space
            Else
                finalResult = finalResult & currentChar                                ' Else, we're in the same word as before, and we only have to add the found character.
            End If
            
            i = i + 1
        Loop
        
        partCount = UBound(stringParts) ' Get how many parts has the string (zero-based)
        
        If partCount > 0 Then   ' If there was something else than just the name
            lastPart = stringParts(partCount)   ' Get the last bit of the string
            
            finalResult = finalResult & " / " & lastPart    ' And attach it to the end result
        End If
        
    End If
    
    stringExtractor = finalResult   ' This will return the full name, separating the words with spaces and (if there is one) the number at the end of the original string.
        
End Function

如果您希望代码仅在存在名称段和“最终编号”段的情况下给出结果,则应像这样移动If子句。

Option Explicit

Public Function stringExtractor(givenString As String) As String
    
    If VBA.Len(givenString) > 0 Then    ' If the user enters an empty string, this prevents execution errors
    
        Dim stringParts() As String
        Dim finalResult As String
        Dim fullName As String
        Dim i As Integer
        Dim currentChar As String
        Dim lastPart As String
        Dim partCount As Integer
        
        stringParts = VBA.Split(givenString, "_")   ' Gets the original string split into its components, and loaded into stringParts
        
        If partCount > 0 Then   ' If there was something else than just the name
            fullName = stringParts(0)   ' Gets the name part into a variable of its own
            finalResult = ""
            i = 1
            
            Do Until i > VBA.Len(fullName)  ' Loops through all the name, to start loading it into the finalResult
            
                currentChar = VBA.Mid(fullName, i, 1)
                
                If currentChar = VBA.UCase(currentChar) And VBA.Len(finalResult) <> 0 Then ' If we find an uppercase character and finalResult is not empty (this is not the first word)
                    finalResult = finalResult & " " & currentChar                           ' we are entering a new word, and we have to enter both the found character and a blank space
                Else
                    finalResult = finalResult & currentChar                                ' Else, we're in the same word as before, and we only have to add the found character.
                End If
                
                i = i + 1
            Loop
            
            partCount = UBound(stringParts) ' Get how many parts has the string (zero-based)
            lastPart = stringParts(partCount)   ' Get the last bit of the string
            
            finalResult = finalResult & " / " & lastPart    ' And attach it to the end result
            
        End If
        
    End If
    
    stringExtractor = finalResult   ' This will return the full name, separating the words with spaces and (if there is one) the number at the end of the original string.
        
End Function

希望这足以解决您的问题,请随时向我询问更多细节。