修改代码，谢谢

sulli112 · 发表于 2021-2-14 22:21

根据要求提取数值，下面这个代码只能匹配所有数字部分提取出来，请问要提取中文小写跟阿拉伯数字要怎么修改呢？，谢谢

Sub 提取数字()
Dim reg As Object, i&, arr
Set reg = CreateObject("vbscript.regexp")
arr = Range("A2:A65536")
With reg
.Global = True
<font color="#ff0000">.Pattern = "[^\d]"</font>
For Each sh In arr
i = i + 1
arr(i, 1) = .Replace(sh, "")
Next
End With
[d2].Resize(UBound(arr), 1) = arr
Set reg = Nothing
End Sub

复制代码

sulli112 · 发表于 2021-2-16 00:16

Sub 提取数字()
Dim reg As Object, i&, Arr
Set reg = CreateObject("vbscript.regexp")
Arr = Range("A2:A65536")
With reg
.Global = True
.Pattern = "[^\d一二三四五六七八九十壹贰叁肆伍陆柒捌玖拾]+"
For Each sh In Arr
i = i + 1
Arr(i, 1) = .Replace(sh, "")
Next
End With
[d2].Resize(UBound(Arr), 1) = Arr
Set reg = Nothing
End Sub

复制代码

修改了一下终于可以同时提取中文小写数字跟阿拉伯数字了，提取后有些结果类似九1,八1,92，不知道要怎么统一修改为只用阿拉伯数字格式表示，类似91,81，92

HuanChen00 · 发表于 2021-2-16 16:13

做一个自定义函数呢？把对应关系加进去，然后调用，这是我能想到的了，判断会多点，但是能实现，其他的办法也没有想到，做鞥一个大佬吧

wanghongfei · 发表于 2021-2-16 18:41

Sub dwds()
Set reg = CreateObject("vbscript.regexp")
arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
brr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
With reg
.Global = True
.Pattern = ".*?([\d一二三四五六七八九十壹贰叁肆伍陆柒捌玖拾]+)|.+"
crr = [a1].CurrentRegion
For x = 2 To UBound(crr)
Cells(x, 2) = .Replace(crr(x, 1), "$1")
Next
End With
For i = LBound(arr) To UBound(arr)
[b:b].Replace brr(i), arr(i), lookat:=xlPart
Next
For x = 2 To UBound(crr)
sr = Cells(x, 2)
If Len(sr) = 2 Then
Cells(x, 2) = Replace(sr, Right(sr, 1), "0" & Right(sr, 1))
End If
Next
End Sub

复制代码

没想到啥好办法

sulli112 · 发表于 2021-2-16 20:20

wanghongfei 发表于 2021-2-16 18:41
没想到啥好办法

请问一下您这个是数组加了字典完成的吗

wanghongfei · 发表于 2021-2-16 20:25

sulli112 发表于 2021-2-16 20:20
请问一下您这个是数组加了字典完成的吗

没有用字典，只是在replace的时候让他们一一对应即可，相当于把一到九全部替换一遍

sulli112 · 发表于 2021-2-16 23:59

[img][/img]

sulli112 · 发表于 2021-2-17 00:09

wanghongfei 发表于 2021-2-16 20:25
没有用字典，只是在replace的时候让他们一一对应即可，相当于把一到九全部替换一遍

http://club.excelhome.net/thread-1574977-1-1.html
https://files-c.excelhome.net/forum/202102/10/121925q535hy5se1eg3jgq.png
像这个链接里面第2楼那个要求可以修改吗，我之前的想法是
1.如果可以直接在A列的基础上统一将中文数字一二三四..............转化为123456789，中文部分不变
2。直接将1修改后的数据全部转化为拼音模式，然后将拼音等于sai/yi/de这三个拼音的（因为有很多是用错别字替代），直接crtl+h一个个替换为赛/依/德，在用正规写法提取中文+数字，实现我想要的结果，类似赛1，依1，德1
3.请问您有没有比较好的写法呢，或者是直接告诉我怎么修改您那段代码可以直接实现1中的要求，我再慢慢修改2的，或者您有更好的方法，也可以告诉我呢，非常感谢

sulli112 · 发表于 2021-2-17 00:10

HuanChen00 发表于 2021-2-16 16:13
做一个自定义函数呢？把对应关系加进去，然后调用，这是我能想到的了，判断会多点，但是能实现，其他的办法 ...

用if函数来一一替换？

sulli112 · 发表于 2021-2-17 11:12

Sub dwds()
Set reg = CreateObject("vbscript.regexp")
arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9)
brr = Array("一", "二", "三", "四", "五", "六", "七", "八", "九")
With reg
.Global = True
.Pattern = ".*?([\d\w^一-龥一二三四五六七八九十]+)|.+"
crr = [a1].CurrentRegion
For x = 1 To UBound(crr)
Cells(x, 2) = .Replace(crr(x, 1), "$1")
Next
End With
For i = LBound(arr) To UBound(arr)
[b:b].Replace brr(i), arr(i), lookat:=xlPart
Next
End Sub

复制代码

这个代码可以直接复制中文加数字，类似赛罗一班可变成赛罗1班

		自动登录	找回密码
密码			免费注册

[求助] 修改代码，谢谢

评分