一个实际遇到的问题， 救助大佬

幽默的熊

附件已上传

根据顾客信息和单价表，自动计算实际价格， 难点已在第二个sheet写明，自己技术搞不定了，特求助大佬！
先拜谢

tzDel

=SUM(VLOOKUP(TOCOL(REGEXP(SUBSTITUTES(B2,{"cm","X","厘米"},{"","x",""}),$F$2:$F$9),3),F:H,3,0)*TOCOL(REGEXP(B2,"(?<=\[)\d+(?=\])")))

一个单元格里有多行的没有解决。$F$2:$F$9把对照表改了一下，去掉了厘米字样

今铭昔

shiruiqiang

正则式比较简单

飞天篮球猪

插件解法...仅供参考...

无与伦比3627

可以试试这个=SUM(IFNA(REDUCE(,REGEXP(B2&0,REGEXP($G$2:$G$9,"\D+",2,".*")&".*?\[\K\d+|.$",3),VSTACK),)*$H$2:$H$9)

ykcbf1100

用正则相对简单，不过，还是有点复杂的。

ykcbf1100

正则参与一下。。。

1. Sub ykcbf()   '//2025.1.16
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     On Error Resume Next
   
4.     With Sheets("原始表")
   
5.         r = .Cells(Rows.Count, 1).End(3).Row
   
6.         .[c2].Resize(r).ClearContents
   
7.         arr = .[a1].Resize(r, 3)
   
8.         zrr = .[g1].CurrentRegion
   
9.         For i = 2 To UBound(zrr)
   
10.             st = ston(zrr(i, 1))
    
11.             d(st) = zrr(i, 2)
    
12.         Next
    
13.         For i = 2 To UBound(arr)
    
14.             b = Split(arr(i, 2), Chr(10))
    
15.             For x = 0 To UBound(b)
    
16.                 s = ston(b(x))
    
17.                 If d.exists(s) Then arr(i, 3) = arr(i, 3) + d(s)
    
18.             Next
    
19.         Next
    
20.         .[a1].Resize(r, 3) = arr
    
21.     End With
    
22.     Set d = Nothing
    
23.     MsgBox "OK！"
    
24. End Sub
    
25. 
    
26. Function ston(st) As Variant
    
27.     Set reg = CreateObject("VBScript.RegExp")
    
28.     st = Replace(LCase(Replace(st, "厘米", "")), "cm", "")
    
29.     With reg
    
30.         .Global = True
    
31.         .Pattern = "(\d+X\d+)"
    
32.         .IgnoreCase = True
    
33.     End With
    
34.     If reg.Test(st) Then
    
35.         Set mh = reg.Execute(st)
    
36.         ston = mh(0).SubMatches(0)
    
37.     End If
    
38. End Function
    

复制代码

幽默的熊

tzDel 发表于 2025-1-15 22:08
=SUM(VLOOKUP(TOCOL(REGEXP(SUBSTITUTES(B2,{"cm","X","厘米"},{"","x",""}),$F$2:$F$9),3),F:H,3,0)*TOCOL ...

十分感谢! 对我很有帮助!

翁知江安

Sub 计算()
Dim i, m, n, st As Integer
Dim k, s, t
Dim ar, br, cr As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
ar = Sheets("原始表").[g1].CurrentRegion
For i = 2 To UBound(ar)
   d(ar(i, 1)) = ar(i, 2)
   s = WorksheetFunction.Substitute(ar(i, 1), "厘米", "")
   t = WorksheetFunction.Substitute(ar(i, 1), "厘米", "cm")
   d(s) = ar(i, 2)
   d(t) = ar(i, 2)
Next
br = Sheets("原始表").[a1].CurrentRegion
ReDim cr(1 To UBound(br) - 1, 1 To 1)
For Each k In d.keys
  For i = 2 To UBound(br)
  m = WorksheetFunction.Find("[", br(i, 2))
  n = WorksheetFunction.Find("]", br(i, 2))
  st = Val(Mid(br(i, 2), m + 1, n - m - 1))
  If InStr(br(i, 2), k) > 1 Then
       cr(i - 1, 1) = cr(i - 1, 1) + d(k) * st
       Else
       cr(i - 1, 1) = cr(i - 1, 1) + 0
  End If
Next
Next
Sheets("原始表").[c2].Resize(50000, 1).ClearContents
Sheets("原始表").[c2].Resize(UBound(br) - 1, 1) = cr
MsgBox "ok"
End Sub