根据A列英文字符串改为B列中文

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.28
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 4).End(3).Row
   
4.     arr = [d1].Resize(r, 2)
   
5.     For i = 2 To UBound(arr)
   
6.         s = arr(i, 1)
   
7.         d(s) = arr(i, 2)
   
8.     Next
   
9.     r = Cells(Rows.Count, 1).End(3).Row
   
10.     arr = [a1].Resize(r, 2)
    
11.     For i = 2 To UBound(arr)
    
12.         st = arr(i, 1)
    
13.         For Each k In d.keys
    
14.             st = Replace(st, k, d(k))
    
15.         Next
    
16.         arr(i, 2) = st
    
17.     Next
    
18.     [a1].Resize(r, 2) = arr
    
19.     Set d = Nothing
    
20.     MsgBox "OK！"
    
21. End Sub
    

复制代码

cnmlgb9998

这种问题用PQ 解决，不要太香。。。。。。。。。。。。。。。。。。。。。。。

kangkumbong

大神们好！
非常感谢大神们指点
经测试非常完美！
谢谢！！！

grf1973

用JSA代码要简洁很多，数组排序一行代码就行了。

kuangben8

最新版WPS似乎有一个函数：SUBSTITUTES 函数，可以实现数组替换。

swl4561255

1. Sub EnglishToChinese()
   
2. arr = Range("A1").CurrentRegion
   
3. brr = Range("D1").CurrentRegion
   
4. Dim crr(1 To 100, 1 To 1)
   
5. Set d = CreateObject("Scripting.Dictionary")
   
6. For i = 2 To UBound(brr)
   
7.     d(brr(i, 1)) = brr(i, 2)
   
8. Next
   
9. k1 = d.keys
   
10. t1 = d.items
    
11. For j = 2 To UBound(arr)
    
12.     m = m + 1
    
13.     myr = arr(j, 1)
    
14.     For k = 0 To d.Count - 1
    
15.         If InStr(myr, k1(k)) Then
    
16.             myr = Replace(myr, k1(k), t1(k))
    
17.         End If
    
18.     Next
    
19.     crr(m, 1) = myr
    
20. Next
    
21. [B10].Resize(m, 1) = crr
    
22. Set d = Nothing
    
23. End Sub
    

复制代码

lizhipei78

tanglf188 发表于 2024-4-28 15:54

这个最简单，学习了

wodewan

kuangben8 发表于 2024-4-29 14:43
最新版WPS似乎有一个函数：SUBSTITUTES 函数，可以实现数组替换。

是的，官方还没更新，测试版可以用，这个题简直就是为这个函数出的。