不求甚解

此博客为个人学习之用,如与其他作品雷同,纯属巧合。

导航

第一步:打开 VBA 编辑器

  1. 打开 Excel 文件(建议新建一个空白文件测试)
  2. 按快捷键:Alt + F11
    → 会弹出一个黑色背景的窗口,叫做 VBA 编辑器

第二步:插入一个模块

在 VBA 编辑器中:

    1. 左侧找到:
      VBAProject (你的文件名)
      → 展开它
      → 右键点击 “模块”(如果没有,右键项目 → 插入 → 模块)

    2. 如果没有“模块”,操作如下:

      • 右键 VBAProject (你的文件名)
      • 选择 插入 → 模块

 

第三步:粘贴完整代码

复制下面这段 完整 VBA 代码

'========================================
' 中文转拼音/五笔简码(压缩版)2025年9月4日
' 函数:=PY(A1) → ZG,=WB(A1) → KH
'========================================
Option Explicit
Private g_pyDict As Object, g_wbDict As Object

Function PY(ByVal text As String) As String
    Dim result As String: result = "": Dim i As Long, ch As String
    If g_pyDict Is Nothing Then InitPYDict
    If g_pyDict Is Nothing Then PY = "ERR": Exit Function
    For i = 1 To Len(text): ch = Mid(text, i, 1)
        If g_pyDict.Exists(ch) Then result = result & g_pyDict(ch) Else
            Dim code As Long: code = AscW(ch): If code < 0 Then code = code + 65536
            If (code >= &H4E00 And code <= &H9FFF) Then result = result & "X" Else result = result & UCase(ch)
        End If: Next i: PY = result
End Function

Function WB(ByVal text As String) As String
    If g_wbDict Is Nothing Then InitWBDict
    If g_wbDict Is Nothing Then WB = "ERR": Exit Function
    Dim i As Long, ch As String, code As String, result As String: result = ""
    For i = 1 To Len(text): ch = Mid(text, i, 1)
        If g_wbDict.Exists(ch) Then code = UCase(g_wbDict(ch)): result = result & Left(code & "  ", 2) Else result = result & "  "
    Next i: WB = result
End Function

Private Sub InitPYDict()
    On Error Resume Next: Set g_pyDict = CreateObject("Scripting.Dictionary")
    If g_pyDict Is Nothing Then Exit Sub
    With g_pyDict: .Add "", "Z": .Add "", "G": .Add "", "R": .Add "", "D": .Add "", "X"
    .Add "", "M": .Add "", "T": .Add "", "S": .Add "", "W": .Add "", "N": .Add "", "T"
    .Add "", "S": .Add "", "M": .Add "", "D": .Add "", "L": .Add "", "Y": .Add "", "E"
    .Add "", "S": .Add "", "S": .Add "", "W": .Add "", "L": .Add "", "Q": .Add "", "B"
    .Add "", "J": .Add "", "S": .Add "", "S": .Add "", "X": .Add "", "B": .Add "", "Z"
    .Add "", "Y": .Add "", "W": .Add "", "W": .Add "", "Y": .Add "", "K": .Add "", "H"
    .Add "", "X": .Add "", "X": .Add "", "B": .Add "", "G": .Add "", "S": .Add "", "X"
    .Add "", "D": .Add "", "N": .Add "", "J": .Add "", "S": .Add "", "K": .Add "", "F"
    .Add "", "C": .Add "", "X": .Add "", "R": .Add "", "J": .Add "", "X": .Add "", "T"
    .Add "", "S": .Add "", "J": .Add "", "W": .Add "", "M": .Add "", "C": End With
End Sub

Private Sub InitWBDict()
    On Error Resume Next: Set g_wbDict = CreateObject("Scripting.Dictionary")
    If g_wbDict Is Nothing Then Exit Sub
    With g_wbDict: .Add "", "kh": .Add "", "lgyi": .Add "", "ww": .Add "", "dddd": .Add "", "ih"
    .Add "", "je": .Add "", "gd": .Add "", "j": .Add "", "tr": .Add "", "wq": .Add "", "wng"
    .Add "", "vng": .Add "", "wuhn": .Add "", "mq": .Add "", "bn": .Add "", "g": .Add "", "fg"
    .Add "", "dg": .Add "", "lh": .Add "", "ar": .Add "", "uy": .Add "", "ag": .Add "", "wt"
    .Add "", "vt": .Add "", "fh": .Add "", "h": .Add "", "gh": .Add "", "gi": .Add "", "dh"
    .Add "", "e": .Add "", "fq": .Add "", "yh": .Add "", "c": .Add "", "sk": .Add "", "vb"
    .Add "", "ipb": .Add "", "nu": .Add "", "lw": .Add "", "wc": .Add "", "pgk": .Add "", "nu"
    .Add "", "jn": .Add "", "ey": .Add "", "rj": .Add "", "ryc": .Add "", "ga": .Add "", "na"
    .Add "", "ld": .Add "", "th": .Add "", "txu": .Add "", "ux": End With
End Sub

第四步:保存为启用宏的文件

  1. 回到 Excel
  2. 点击 文件 → 另存为
  3. 选择保存类型:
    Excel 启用宏的工作簿 (*.xlsm)
  4. 文件名例如:拼音五笔转换.xlsm
  5. 点“保存”

第五步:启用宏并测试

  1. 关闭 Excel

  2. 重新打开 刚才保存的 .xlsm 文件

  3. 如果出现安全警告:
    → 点击 “启用内容”(非常重要!)

  4. 在 Excel 中测试:

A1B1(输入公式)预期结果
中国 =PY(A1) ZG
中国 =WB(A1) KH
人工智能 =PY(A1) RZ
人工智能 =WB(A1) WWJE