修改代码，谢谢

wanghongfei

拼音对应汉字做了个

sulli112

wanghongfei 发表于 2021-2-17 11:58
拼音对应汉字做了个

Sub sawd()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For x = 1 To UBound(brr)
    brr(x, 1) = PinYin(Cells(x, 1))
Next
[b1].Resize(UBound(brr), 1) = brr
a = Array("sai", "yi", "de")
b = Array("赛", "依", "德") 请教一下，假如我想新增一个“ban”的拼音对应“班”字，为啥不行呢，请问要怎么修改呢？我刚刚试了将“de"修改为”ban"之后，“国际部德一班”的取值答案就会变成依1而不是班1，请问是什么原理呢，非常感谢

For i = 0 To 2
    [b:b].Replace a(i), b(i)
Next
Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.Pattern = "[^\u4e00-\u9fa5]+" '\u4e00-\u9fa5是用来判断是不是中文的一个条件
For x = 1 To UBound(brr)
    Cells(x, 2) = Mid(.Replace(Cells(x, 2).Value, ""), 1, 1)
Next
.Pattern = ".*?([\d一二三四五六七八九十壹贰叁肆伍陆柒捌玖拾]+)|.+"
For x = 1 To UBound(brr)
    Cells(x, 3) = .Replace(Cells(x, 1), "$1")
Next
crr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
drr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
For x = 0 To 8
[c:c].Replace drr(x), crr(x)
Next
For x = 1 To UBound(brr)
    If Cells(x, 1) Like "*[a-zA-Z]*" Then
        Cells(x, 2) = Cells(x, 1)
    Else
        Cells(x, 2) = Cells(x, 2) & Cells(x, 3)
    End If
Next
End With
[c1].Resize(UBound(brr), 1).ClearContents
End Sub

wanghongfei

sulli112 发表于 2021-2-17 14:16
Sub sawd()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)

我这个是根据你最开始说的编写的，如果要加别的字还得重新改。如果只是加班字 可以直接在最后一个循环处直接加个班字

sulli112

wanghongfei 发表于 2021-2-17 18:45
我这个是根据你最开始说的编写的，如果要加别的字还得重新改。如果只是加班字 可以直接在最后一个循环处 ...

Sub sawd()
arr = [a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For x = 1 To UBound(brr)
    brr(x, 1) = PinYin(Cells(x, 1))
Next
[b1].Resize(UBound(brr), 1) = brr
a = Array("sai", "yi", "de", "ban")
b = Array("赛", "依", "德", "班")
For i = 0 To 2
    [b:b].Replace a(i), b(i)
Next
Set reg = CreateObject("vbscript.regexp")
With reg
.Global = True
.Pattern = "[^\u4e00-\u9fa5]+" '\u4e00-\u9fa5是用来判断是不是中文的一个条件
For x = 1 To UBound(brr)
    Cells(x, 2) = Mid(.Replace(Cells(x, 2).Value, ""), 1, 1)
Next
.Pattern = ".*?([\d一二三四五六七八九十壹贰叁肆伍陆柒捌玖拾]+)|.+"
For x = 1 To UBound(brr)
    Cells(x, 3) = .Replace(Cells(x, 1), "$1")
Next
crr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
drr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
For x = 0 To 8
[c:c].Replace drr(x), crr(x)
Next
For x = 1 To UBound(brr)
    If Cells(x, 1) Like "*[a-zA-Z]*" Then
        Cells(x, 2) = Cells(x, 1)
    Else
        Cells(x, 2) = Cells(x, 2) & Cells(x, 3)
    End If
Next
End With
[c1].Resize(UBound(brr), 1).ClearContents
End Sub

我不太懂最后加一个循环要在哪里加呢？或者你标红告诉我如果要加别的字要在那几处修改，我试一下能不能自己修改，谢谢