把A列杂乱的班级名标准化B列的样子

今铭昔

===============================================================
第19行写错了，本意是把123替换成七八九。不过也是少数（只有一个），我觉得这一行略显多余了

x-xx-xx

20220831_141241.rar (58.36 KB, 下载次数: 20)

2022-8-31 14:13 上传

点击文件名下载附件

ykcbf1100

x-xx-xx 发表于 2022-8-31 14:13

有点高深啊，一下子看不懂。谢谢。

ykcbf1100

今铭昔 发表于 2022-8-31 14:05
===============================================================
第19行写错了，本意是把123替换成七 ...

我只有office啊，wps版宏我用不了。不过，谢谢你的帮助。

xiangbaoan

参与.zip (23.84 KB, 下载次数: 39)

2022-8-31 15:16 上传

点击文件名下载附件

ykcbf1100

xiangbaoan 发表于 2022-8-31 15:16

强的，都能转换过来。

七⑧斑，这个能转成七（8）班，超牛！

xiangbaoan

ykcbf1100 发表于 2022-8-31 15:25
强的，都能转换过来。

七⑧斑，这个能转成七（8）班，超牛！

改一处.zip (25.53 KB, 下载次数: 49)

2022-8-31 15:27 上传

点击文件名下载附件

ykcbf1100

xiangbaoan 发表于 2022-8-31 15:27

今天没分了，明天补吧。

紫川文秀

1. Public Sub tt()
   
2.     Dim arr As Variant, i&, n&, reg As Object, j&, matches As Variant, m&, str$
   
3.     n = Sheet1.UsedRange.Rows.Count
   
4.     arr = Sheet1.Range("a2:a" & n).Value
   
5.     Set reg = CreateObject("vbscript.regexp")
   
6.     reg.Pattern = "\d"
   
7.     reg.Global = True
   
8.     For i = 1 To UBound(arr)
   
9.         arr(i, 1) = Replace(arr(i, 1), "初一", "7")
   
10.         arr(i, 1) = Replace(arr(i, 1), "初二", "8")
    
11.         arr(i, 1) = Replace(arr(i, 1), "初三", "9")
    
12.         arr(i, 1) = Replace(arr(i, 1), "一十", "1")
    
13.         arr(i, 1) = Replace(arr(i, 1), "二十", "2")
    
14.         arr(i, 1) = Replace(arr(i, 1), "三十", "3")
    
15.         arr(i, 1) = Replace(arr(i, 1), "十班", "10")
    
16.         arr(i, 1) = Replace(arr(i, 1), "十", "1")
    
17.         arr(i, 1) = Replace(arr(i, 1), "一", "1")
    
18.         arr(i, 1) = Replace(arr(i, 1), "二", "2")
    
19.         arr(i, 1) = Replace(arr(i, 1), "三", "3")
    
20.         arr(i, 1) = Replace(arr(i, 1), "四", "4")
    
21.         arr(i, 1) = Replace(arr(i, 1), "五", "5")
    
22.         arr(i, 1) = Replace(arr(i, 1), "六", "6")
    
23.         arr(i, 1) = Replace(arr(i, 1), "七", "7")
    
24.         arr(i, 1) = Replace(arr(i, 1), "八", "8")
    
25.         arr(i, 1) = Replace(arr(i, 1), "九", "9")
    
26.         Set matches = reg.Execute(arr(i, 1))
    
27.         m = matches.Count
    
28.         If m > 1 Then
    
29.             str = matches(0) & "（"
    
30.             For j = 1 To m - 1
    
31.                 str = str & matches(j)
    
32.             Next
    
33.             str = str & "）班"
    
34.             arr(i, 1) = str
    
35.         Else
    
36.             If arr(i, 1) <> "" Then arr(i, 1) = "匹配错误!请手动核查!"
    
37.         End If
    
38.     Next
    
39.     Sheet1.Range("b2:b" & n).Value = arr
    
40.     Set matches = Nothing
    
41.     Set reg = Nothing
    
42. End Sub

复制代码

匹配错误的,会让手动核查

ykcbf1100

紫川文秀 发表于 2022-8-31 16:27
匹配错误的,会让手动核查

谢谢了，今天没分了，明天补了。