根据大小写字符串和大写字母

Question

我有一些要转换的起始编码约定的列名，请参见示例：

   Original        Target     
 ------------- -------------- 
  partID        Part ID       
  completedBy   Completed By 

我在VBA中有一个函数，可以用大写字母分割原始字符串：

Function SplitCaps(strIn As String) As String
Dim objRegex As Object
Set objRegex = CreateObject("vbscript.regexp")
With objRegex
    .Global = True
    .Pattern = "([a-z])([A-Z])"
    SplitCaps = .Replace(strIn, "$1 $2")
End With
End Function

我将此函数包装在PROPER中，例如，PROPER（SplitCaps（A3））为第三行产生了所需的结果，但ID中的“ D”没有大写。

   Original        Actual    
 ------------- -------------- 
  partID        Part Id       
  completedBy   Completed By 

有人能想到一种向此功能添加案例的解决方案吗？

Answer 1

分开使用单词并循环显示结果，并在使用Proper之前测试是否全部大写。然后加入他们的行列：

Sub kjl()
Dim str As String
str = "partID"

Dim strArr() As String
strArr = Split(SplitCaps(str), " ")

Dim i As Long
For i = 0 To UBound(strArr)
    If UCase(strArr(i)) <> strArr(i) Then
        strArr(i) = Application.Proper(strArr(i))
    End If
Next i

str = Join(strArr, " ")

Debug.Print str
End Sub

---

如果您希望公式执行您要的操作，则：

=TEXTJOIN(" ",TRUE,IF(EXACT(UPPER(TRIM(MID(SUBSTITUTE(SplitCaps(A1)," ",REPT(" ",999)),{1,999},999))),TRIM(MID(SUBSTITUTE(SplitCaps(A1)," ",REPT(" ",999)),{1,999},999))),TRIM(MID(SUBSTITUTE(SplitCaps(A1)," ",REPT(" ",999)),{1,999},999)),PROPER(TRIM(MID(SUBSTITUTE(SplitCaps(A1)," ",REPT(" ",999)),{1,999},999)))))

退出编辑模式时，通过按Ctrl-Shift-Enter而不是Enter进行确认，作为数组公式输入。

---

或将以上代码用作功能：

Function propSplitCaps(str As String)

Dim strArr() As String
strArr = Split(SplitCaps(str), " ")

Dim i As Long
For i = 0 To UBound(strArr)
    If UCase(strArr(i)) <> strArr(i) Then
        strArr(i) = Application.Proper(strArr(i))
    End If
Next i

propSplitCaps = Join(strArr, " ")
End Function

命名为=propSplitCaps(A1)

Answer 2

在转换中分割字符串后，只需使用每个单词的第一个字母大写即可代替使用Proper函数。

Option Explicit
Function Cap(s As String) As String
    Dim RE As RegExp, MC As MatchCollection, M As Match
    Const sPatSplit = "([a-z])([A-Z])"
    Const sPatFirstLtr As String = "\b(\w)"
    Const sSplit As String = "$1 $2"
Set RE = New RegExp
With RE
    .Global = True
    .Pattern = sPatSplit
    .IgnoreCase = False
    If .Test(s) = True Then
        s = .Replace(s, sSplit)

        .Pattern = sPatFirstLtr
        Set MC = .Execute(s)
        For Each M In MC
            s = WorksheetFunction.Replace(s, M.FirstIndex + 1, 1, UCase(M))
        Next M
    End If
End With

Cap = s
End Function