怎样用宏替换指定的字符为相应的文本

naizhu2

在图1 中的c1:d10的区域中,给每个教室安排了老师监考，语文，数学，英语，物理，生物，地理这6个科目。其中“语数英物生地”这6个科目分别用了ab cdef这6个英语字母来代表。详细的对应关系见这两列I2:h7,如图2， 最后要求把这6个字母还原成汉字。效果达到第3张图中的示范效果，请注意英语字母ABCdef是动态的。它们之间的对应关系不一定一直是按“语数英物生地””来对应的哦，所以在使用宏公司的时候，字母a的取值只能用单元格i2的取值。这个值不一定是语文哈。是动态的，

iris_2356

直接Ctrl H 替换就行了吧

gdfcx

1. Sub macro()
   
2.     Dim arr, brr, i%, j%, m%, n%, str$, str1$
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = [h2:i7]
   
5.     brr = [c2:d10]
   
6.     For i = 1 To UBound(arr)
   
7.         d(arr(i, 1)) = arr(i, 2)
   
8.     Next i
   
9.     For m = 1 To UBound(brr)
   
10.         For n = 1 To UBound(brr, 2)
    
11.             brr(m, n) = Replace(brr(m, n), "(", "（")
    
12.             str = Split(brr(m, n), "（")(1)
    
13.             L = Len(str) - 1
    
14.             ReDim crr(1 To L)
    
15.             For j = 1 To L
    
16.                 crr(j) = d(Mid(str, j, 1))
    
17.             Next j
    
18.             str1 = Join(crr, ",")
    
19.             brr(m, n) = Split(brr(m, n), "（")(0) & "（" & str1 & ")"
    
20.         Next n
    
21.     Next m
    
22.     [k2:l10] = brr
    
23.     Set d = Nothing
    
24. End Sub

复制代码

gdfcx

附件供参考：

zopey

1. Public dic
   
2. 
   
3. Sub pey_testb()
   
4. Dim brr, k2
   
5. k2 = [h1].End(4).Row - 1
   
6. brr = [h2].Resize(k2, 2)
   
7. 
   
8. Set dic = CreateObject("scripting.dictionary")
   
9. For i = 1 To k2
   
10.    dic(brr(i, 1)) = brr(i, 2)
    
11. Next
    
12. 
    
13. ''''''''''''''''''''''''''''
    
14. k0 = [c1].End(4).Row - 1
    
15. arr = [c2].Resize(k0, 2)
    
16. 
    
17. With CreateObject("VBScript.RegExp")
    
18.   .Global = True
    
19.   .IgnoreCase = False
    
20.   .Pattern = "([a-f]*)"
    
21.   
    
22.   For i = 1 To k0
    
23.   For j = 1 To 2
    
24.      txt = arr(i, j)
    
25.      arr(i, j) = Evaluate("=""" & .Replace(txt, """&qukh(" & """$1""" & ")&""") & """")
    
26.   Next
    
27.   Next
    
28. End With
    
29. 
    
30. Cells(2, 11).Resize(k0, 2) = arr
    
31. End Sub
    
32. 
    
33. Function qukh(a) 'a-b规则，可以自由定制
    
34. b = dic(Mid(a, 1, 1))
    
35. For i = 2 To Len(a)
    
36.     b = b & "、" & dic(Mid(a, i, 1))
    
37. Next
    
38. 
    
39. qukh = b
    
40. End Function

复制代码

一把小刀闯天下

'有大写左括号，，，

Option Explicit

Sub test()
  Dim arr, i, j, brr
  arr = [c1].CurrentRegion: brr = [h2:i7]
  For i = 2 To UBound(arr, 1)
    For j = 1 To UBound(brr, 1)
      arr(i, 1) = Replace(arr(i, 1), brr(j, 1), "、" & brr(j, 2))
      arr(i, 2) = Replace(arr(i, 2), brr(j, 1), "、" & brr(j, 2))
    Next
    arr(i, 1) = Replace(arr(i, 1), "(、", "(")
    arr(i, 2) = Replace(arr(i, 2), "(、", "(")
  Next
  [k1].Resize(UBound(arr, 1), 2) = arr
End Sub

naizhu2

gdfcx 发表于 2019-6-5 22:03
附件供参考：

非常感谢，几位的答案你的最简洁，改编也很容易，但是发现个你给的代码的中的新问题，就是你的代码运行时必须要求c2:d10的单元格原数据都不能为空，如果其中有一个空格，运行时就出现下标越界的情况，比如下图4最后两格我把它调整为空单元格后，我在指定的区域c2:10内一运行就出错，请问有办法避免吗？谢谢

naizhu2

iris_2356 发表于 2019-6-5 21:19
直接Ctrl H 替换就行了吧

要替换很多次，依次输入查询a ,b ,c d,e,f，然后依次输入语文数学英语物理，生物，地理等，且以后可能还有不同的学科，用公式我相信会批量解决，而且可以有扩展性

naizhu2

一把小刀闯天下 发表于 2019-6-6 15:05
'有大写左括号，，，

Option Explicit

仔细对比了，发现你的代码很简单，而且上边一位给的代码在运行时碰到单元格为空就出错，你的代码就能兼容这种，但是我在改编时有个新问题，就是如果原始数据从c列扩展到了e列，（即增加了1列，）此时我改编代码后，第一排的数据始终还是字母ab等等，没法转换为相应的字符，请你帮我看下，我的代码改编后是Sub test()
  Dim arr, i, j, brr
  arr = [c1].CurrentRegion: brr = [h2:i7]
  For i = 3 To UBound(arr, 1)
    For j = 1 To UBound(brr, 1)
      arr(i, 1) = Replace(arr(i, 1), brr(j, 1), "、" & brr(j, 2))
      arr(i, 2) = Replace(arr(i, 2), brr(j, 1), "、" & brr(j, 2))
      arr(i, 3) = Replace(arr(i, 3), brr(j, 1), "、" & brr(j, 2))
    Next
    arr(i, 1) = Replace(arr(i, 1), "(、", "(")
    arr(i, 2) = Replace(arr(i, 2), "(、", "(")
    arr(i, 3) = Replace(arr(i, 3), "(、", "(")
  Next
  [k1].Resize(UBound(arr, 1), 3) = arr
End Sub

错在哪里呢，附件见下图

naizhu2

一把小刀闯天下 发表于 2019-6-6 15:05
'有大写左括号，，，

Option Explicit

如果增加一列，结果就出现第2行字母不能转换，其余行正常，如图6