提取不规则单元格内的金额

ykcbf1100

代码供参考。。。

1. Sub ykcbf()   '//2024.3.8
   
2.     Set reg = CreateObject("VBScript.Regexp")
   
3.     On Error Resume Next
   
4.     With Sheets("Sheet1")
   
5.         r = .Cells(Rows.Count, "s").End(3).Row
   
6.         arr = .[s1].Resize(r, 5)
   
7.         With reg
   
8.             .Global = True
   
9.             .IgnoreCase = True
   
10.             .Pattern = "(\d+(\.\d{1,2})?)$"
    
11.             For i = 6 To UBound(arr)
    
12.                 If arr(i, 2) <> Empty Then
    
13.                     b = Split(arr(i, 2), Chr(10))
    
14.                     m = 4
    
15.                     For x = 0 To 1
    
16.                         s = b(x)
    
17.                         Set mh = .Execute(s)
    
18.                         m = m + x
    
19.                         arr(i, m) = Val(mh(0).Value)
    
20.                     Next
    
21.                 End If
    
22.             Next
    
23.         End With
    
24.         .[s1].Resize(r, 5) = arr
    
25.     End With
    
26.     MsgBox "OK！"
    
27. End Sub
    
28. 
    

复制代码

ykcbf1100

limonet 发表于 2024-3-8 19:27
关键字：￥，加CDbl，主要是转换。

你的代码很简洁，要向你学习。

fzxba

Sub test0() '至简
  Dim a, b(), c
  Dim i As Long, j As Long, k As Long
  a = Range("T6", Cells(Rows.Count, "T").End(xlUp))
  ReDim b(1 To UBound(a), 1 To 2)
  For i = 1 To UBound(a)
    If Len(a(i, 1)) Then
      c = Split(a(i, 1), vbLf)
      For j = 0 To UBound(c)
        k = InStr("收含", Left(c(j), 1))
        If k Then b(i, k) = b(i, k) + Val(StrReverse(Val(StrReverse(c(j)))))
      Next
    End If
  Next
  Range("AA6").Resize(UBound(b), UBound(b, 2)) = b
End Sub

fzxba

常规操作审见附件.zip (18.38 KB, 下载次数: 4)

2024-3-8 20:16 上传

点击文件名下载附件

huarong7984

shiruiqiang 发表于 2024-3-8 18:19
[^V｜一-龢]\d+\.？\d+

Sub test()
Dim rng As Range, ss, sj
Set reg = CreateObject("vbscript.regexp")

n = 1
h = Range("t65536").End(xlUp).Row
For Each rng In Range("t5:t" & h)
If InStr(rng, "款") Then
With reg
.Global = True
.Pattern = "[^V｜一-龢]\d+\.?\d+"
   Set ss = .Execute(rng)
   For Each sj In ss
   sj = sj * 1                            '增加此句代码，将文本数字转换为数值型数字
   n = n + 1
   rng.Offset(0, n) = sj
   Next
   n = 1
End With
End If
Next
End Sub

limonet

ykcbf1100 发表于 2024-3-8 19:57
你的代码很简洁，要向你学习。

学无止境，共同进步。

ykcbf1100

limonet 发表于 2024-3-8 20:33
学无止境，共同进步。

OK。。。。

伊可赛二