VBA实现驼峰法变量名转换成下横杠式变量名

在excel中按ALT+F11打开VBA编辑器，选择插入模块

在模块中输入下面代码：

Sub 名称和识别子生成()
    ' 正规表示
    Dim oRegExp As Object

    Dim shtCount As Integer
    If ActiveSheet.Cells(2, 1).Value <> "" Then
    shtCount = ActiveSheet.Cells(1, 1).End(xlDown).Row
    
        Dim i As Integer
        For i = 2 To shtCount
        
            Set oRegExp = CreateObject("vbscript.regexp")
            oRegExp.Global = True
            oRegExp.IgnoreCase = False
            oRegExp.Pattern = "[^a-zA-Z0-9]"
            ActiveSheet.Cells(i, 3).Value = Replace(oRegExp.Replace(ActiveSheet.Cells(i, 1).Value, ""), " ", "")
            ActiveSheet.Cells(i, 4).Value = 识别子(ActiveSheet.Cells(i, 1).Value)
            
        Next i
    
        Set oRegExp = Nothing
    
        MsgBox "名称和识别子生成成功！"
    End If

End Sub

Sub 识别子生成名称()

    Dim shtCount As Integer
    If ActiveSheet.Cells(2, 1).Value <> "" Then
        shtCount = ActiveSheet.Cells(1, 1).End(xlDown).Row
        Dim j As Integer
        For j = 2 To shtCount
        
            Dim result As String
            
            Dim strArray() As String
            strArray = Split(ActiveSheet.Cells(j, 1).Value, "_")
            Dim i As Integer
            For i = 0 To UBound(strArray)
            
                If i = 0 Then
                    result = strArray(i)
                Else
                    result = result & UCase(Left(strArray(i), 1)) & Right(strArray(i), Len(strArray(i)) - 1)
                End If
            Next i
            ActiveSheet.Cells(j, 3).Value = result
        Next j
    End If
    
    MsgBox "识别子生成名称成功！"
End Sub


Function 识别子(str As String) As String

    Dim tempString As String
    If Trim(str) <> "" Then
        Dim wordArray() As String
        wordArray = Split(Trim(str), " ")
        Dim j As Integer
        For j = 0 To UBound(wordArray)
            
            If wordArray(j) <> UCase(wordArray(j)) Then
            
                Dim outWord As String
                outWord = ""
                Dim byteArray() As String
                ReDim byteArray(1 To Len(wordArray(j)))
                
                Dim i As Integer
                For i = 1 To Len(wordArray(j))
                
                    byteArray(i) = Mid(wordArray(j), i, 1)
                    If byteArray(i) Like "[A-Z]" And i <> 1 Then
                        byteArray(i) = " " & LCase(byteArray(i))
                    Else
                        byteArray(i) = LCase(byteArray(i))
                    End If
                    outWord = outWord & byteArray(i)
                Next i
                
                wordArray(j) = outWord
            Else
                wordArray(j) = LCase(wordArray(j))
            
            End If
            tempString = tempString & wordArray(j) & " "
        Next j

        tempString = Left(tempString, Len(tempString) - 1)

        ' 正则表示
        Dim oRegExp As Object
        
        Set oRegExp = CreateObject("vbscript.regexp")
        oRegExp.Global = True
        oRegExp.IgnoreCase = False
        oRegExp.Pattern = "[^a-zA-Z0-9 ]"
        识别子 = LCase(Replace(oRegExp.Replace(tempString, ""), " ", "_"))
        Set oRegExp = Nothing
    End If
End Function

然后，在EXCEL文件里按ALT+F8，会出现模块中的宏代码

点击执行就可以将图中名称转换，或是点击选项设置快捷键，以后按快捷键自动转换

               

输入q（小写q）则快捷键就是CTRL+Q

输入Q（大写Q）则快捷键就是CTRL+SHIFT+Q

也可以插入形状，然后右键选择指定宏也可