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

ykcbf1100

smiletwo 发表于 2022-9-2 23:47
全部标化见附件

刚看到，这应该是我看到的目前为止最接近完美的解法了，除了无解的，都解出来了，必须赞一个！

hjd528

fzxba 发表于 2024-2-15 08:30

谢谢！完美解决！

fzxba

hjd528 发表于 2024-2-15 10:03
谢谢！完美解决！

lxdexcel

1. Private Sub CommandButton1_Click()
   
2.    Dim str$, st$, s$
   
3.    Dim k&, n&, p&, i&, r&
   
4.    str = "一二三四五六七八九十0123456789"
   
5.    For i = 2 To Range("A65536").End(xlUp).Row
   
6.      s = ""
   
7.      st = Cells(i, 1)
   
8.      n = Len(st)
   
9.      k = 1
   
10.      Do While k <= n
    
11.        p = InStr(str, Mid(st, k, 1))
    
12.        If p > 0 Then
    
13.             If p >= 11 Then p = p - 11
    
14.             If p < 7 Then p = p + 6
    
15.             s = Mid(str, p, 1)
    
16.             Exit Do
    
17.        End If
    
18.        k = k + 1
    
19.      Loop
    
20.      k = k + 1
    
21.      r = 0
    
22.      Do While k <= n
    
23.        p = InStr(str, Mid(st, k, 1))
    
24.        If p > 0 Then
    
25.            If p >= 11 Then p = p - 11
    
26.               If r = 0 Then
    
27.                   r = p
    
28.               ElseIf r < 10 Then
    
29.                   If p <> 10 Then
    
30.                      r = r * 10 + p
    
31.                   Else
    
32.                      r = r * 10
    
33.                    End If
    
34.               Else
    
35.                  r = r + p
    
36.               End If
    
37.        End If
    
38.        k = k + 1
    
39.      Loop
    
40.      If r = 0 Then
    
41.         s = s & " (?) 班"
    
42.      Else
    
43.         s = s & " (" & r & ") 班"
    
44.      End If
    
45.      Cells(i, 2) = s
    
46.    Next
    
47. End Sub

复制代码

ykcbf1100

lxdexcel 发表于 2024-2-15 15:20

优秀作品，除个别外，基本上都解出来了，赞一个！

yjh_27

ykcbf1100 发表于 2024-2-15 15:25
优秀作品，除个别外，基本上都解出来了，赞一个！

加几句，都可以解出来

1. Private Sub CommandButton1_Click()
   
2.    Dim str$, st$, s$
   
3.    Dim k&, n&, p&, i&, r&
   
4.    str = "一二三四五六七八九十0123456789①②③④⑤⑥⑦⑧⑨⑩"
   
5.    For i = 2 To Range("A65536").End(xlUp).Row
   
6.      s = ""
   
7.      st = Cells(i, 1)
   
8.      n = Len(st)
   
9.      k = 1
   
10.      Do While k <= n
    
11.        p = InStr(str, Mid(st, k, 1))
    
12.        k = k + 1
    
13.        If p > 0 Then
    
14.             If p >= 11 Then p = p - 11
    
15.             If p < 7 Then p = p + 6
    
16.             s = Mid(str, p, 1)
    
17.             Exit Do
    
18.        End If
    
19.      Loop
    
20.      r = 0
    
21.      p0 = 0
    
22.      Do While k <= n
    
23.        p = InStr(str, Mid(st, k, 1))
    
24.        If p > 0 Then
    
25.             If p < 11 Then p1 = 1 Else p = p - 11: p1 = 0
    
26.             If p > 9 Then p = p - 9
    
27.             If r = 0 Then
    
28.                 r = p
    
29.             ElseIf p0 = 1 And p1 = 0 Then
    
30.                 r = p
    
31.             ElseIf r < 10 Then
    
32.                 If p <> 10 Then
    
33.                    r = r * 10 + p
    
34.                 Else
    
35.                    r = r * 10
    
36.                  End If
    
37.             Else
    
38.                r = r + p
    
39.             End If
    
40.             p0 = p1
    
41.        End If
    
42.        k = k + 1
    
43.      Loop
    
44.      If r = 0 Then
    
45.         s = s & " (?) 班"
    
46.      Else
    
47.         s = s & " (" & r & ") 班"
    
48.      End If
    
49.      Cells(i, 2) = s
    
50.    Next
    
51. End Sub
    

复制代码

ykcbf1100

yjh_27 发表于 2024-2-16 22:05
加几句，都可以解出来

完美，明天送花。

桑榆非晚123

正则表达式还没学会，用了提取字符串数字的办法

ykcbf1100

桑榆非晚123 发表于 2024-2-17 13:53
正则表达式还没学会，用了提取字符串数字的办法

谢谢，能解出大部分了。
702,这类没解出。

桑榆非晚123

ykcbf1100 发表于 2024-2-17 19:52
谢谢，能解出大部分了。
702,这类没解出。

再加一层判断就可以，但是我感觉似乎我这个不是最好的解决办法。所以就没继续写了