WORD中的元变成万元？希望哪个网友再补充一个excel版的代码（补充要求附件在17楼）

sdytsxd991122

kevinchengcw

1. Sub test()
   
2. Dim S$, Obj
   
3. S = StrConv(ThisDocument.Range.Text, vbNarrow)
   
4. With CreateObject("vbscript.regexp")
   
5.   .Global = True: .Pattern = "(\d+(?:,?\d{3})+(?:\.\d+)?)元"
   
6.   If .test(S) Then
   
7.     For Each Obj In .Execute(S)
   
8.       ThisDocument.Range.Find.Execute Obj.Value, , , 2, , , , , , _
   
9.           Format(Val(Replace(Obj.submatches(0), ",", "")) / 10000, "#,##0.00万元"), 1
   
10.     Next Obj
    
11.   End If
    
12. End With
    
13. End Sub

复制代码

limonet

Sub limonet()
    Selection.HomeKey unit:=wdStory
    With Selection.Find
        .Text = "[0-9,]@.[0-9]@元"
        .Forward = True
        .Wrap = wdFindContinue
        .MatchWildcards = True
    End With
    Do While Selection.Find.Execute
        Selection.TypeText Text:=Round(CCur(Left(Selection.Text, Len(Selection.Text) - 1)) / 10000, 2) & "万元"
    Loop
End Sub

limonet

关键字：matchwildcards

tcdatongye

wshcw 发表于 2024-9-11 09:04
转换结果还不完善：
1.从2022年8月开始对我县71家中小微企业单位实行应征部分缓缴184.90元，缓解了大部 ...

Sub 宏1()
    With ThisDocument.Content.Find
        .Text = "([.0-9,]{1,})元"
        .MatchWildcards = True
        Do While .Execute(Replace:=wdReplaceOne, replacewith:="\1")
          .Parent = Format(Replace(.Parent, ",", "") / 10000, "#,##0.00万元")
          .Parent.Move
        Loop
    End With
End Sub

wshcw

13楼和15楼经测试能正确转换，其中15楼代码更简洁。

wshcw

希望哪个网友再补充一个excel版的代码
将元转换为万元并保留两位小数

wshcw

顶一下，希望再补充一个excel版的代码

limonet

Sub limonet()
    Dim Arr As Variant, i%, Ms As Object, j%
    Arr = Intersect(Range("A2:A65536"), Range("A1").CurrentRegion)
    With CreateObject("vbscript.regexp")
        .Pattern = "[0-9,]+\.[0-9]+(?=元)"
        .Global = True
        For j = 1 To UBound(Arr)
            Set Ms = .Execute(Arr(j, 1))
            For i = Ms.Count - 1 To 0 Step -1
                Arr(j, 1) = Application.Replace(Arr(j, 1), Ms(i).FirstIndex + 1, Ms(i).Length, Format(Ms(i) / 10000, "#,##0.00万"))
            Next i
        Next j
    End With
    Range("B2").Resize(j - 1) = Arr
End Sub

limonet

关键字property.firstindex+length