统计问题

coden0906

本人初学者，请教大神，已按之前大神的方法，做了修改，但是统计速度很慢，不知该如何优化？

已知单价图


要求统计合计值（黄色部分自动生成）


我弄的代码如下：

Private Sub CommandButton1_Click()
  Dim r%, i%
  Dim arr
  Dim reg As New RegExp
      Application.ScreenUpdating = False
  With reg
    .Global = True
    .Pattern = "([^\*\+]+)\*?(\d+)?"
  End With
  With ThisWorkbook.Worksheets("清单表")
    r = .Cells(.Rows.Count, 1).End(xlUp).Row
    arr = .Range("a2:c" & r)
  End With
  u = ThisWorkbook.Worksheets("单价").Range("A65535").End(xlUp).Row
  For i = 1 To UBound(arr)
    dj = 0
    jz = 0
    Set mh = reg.Execute(arr(i, 3))
    If ThisWorkbook.Worksheets("清单表").Cells(i + 1, 4).Value = "" Then
      For j = 0 To mh.Count - 1
      xm = mh(j).SubMatches(0)
      sl = Val(mh(j).SubMatches(1))
        For t = 2 To u
          If ThisWorkbook.Worksheets("单价").Cells(t, 1) = xm Then
          dj = ThisWorkbook.Worksheets("单价").Cells(t, 2).Value

          End If
        Next
        If sl = 0 Then
          sl = 1
        End If
        jz = jz + dj * sl
      Next
         ThisWorkbook.Worksheets("清单表").Cells(i + 1, 4).Value = jz
    End If

  Next

    Application.ScreenUpdating = True
End Sub



样表.zip (28.31 KB, 下载次数: 4)

2018-6-25 14:24 上传

点击文件名下载附件

JiaDongjun

直接把礼品名称替换为单价不就行了

liulang0808

1. Sub 按钮3_Click()
   
2.     Application.ScreenUpdating = False
   
3.     arr = Sheets("清单表").UsedRange
   
4.     brr = Sheets("单价").UsedRange
   
5.     For j = 2 To UBound(brr)
   
6.         Sheets("清单表").Columns(3).Replace brr(j, 1), brr(j, 2)
   
7.     Next j
   
8.     For j = 2 To UBound(arr)
   
9.         arr(j, 5) = Application.Evaluate(Sheets("清单表").Cells(j, 3).Value)
   
10.     Next j
    
11.     Sheets("清单表").UsedRange = arr
    
12.     Application.ScreenUpdating = True
    
13. End Sub
    

复制代码

liulang0808

附件内容供参考，修改了思路。。。

jiangxiaoyun

1. Sub vvv()
   
2.     Dim arr, brr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheet2.[a1].CurrentRegion
   
5.     For i = 2 To UBound(arr)
   
6.         d(arr(i, 1)) = arr(i, 2)
   
7.     Next
   
8.    
   
9.     With Sheet1
   
10.         brr = .Range("c2:d" & .[a1].Cells(Rows.Count, 1).End(xlUp).Row)
    
11.         For i = 1 To UBound(brr)
    
12.             If InStr(brr(i, 1), "+") > 0 Then
    
13.                 s = Split(brr(i, 1), "+")
    
14.                 For x = 0 To UBound(s)
    
15.                     ss = Split(s(x), "*")
    
16.                     brr(i, 2) = brr(i, 2) + d(ss(0)) * Val(ss(1))
    
17.                 Next
    
18.             Else
    
19.                 ss = Split(brr(i, 1), "*")
    
20.                 brr(i, 2) = d(ss(0)) * Val(ss(1))
    
21.             End If
    
22.             
    
23.         Next
    
24.         .[d2].Resize(UBound(brr), 1) = Application.Index(brr, , 2)
    
25.     End With
    
26.    
    
27. End Sub

复制代码

jiangxiaoyun

样表.zip (22.93 KB, 下载次数: 0)

2018-6-25 15:17 上传

点击文件名下载附件

审核挺烦的，

不知道为什么

liulang0808 发表于 2018-6-25 15:09
附件内容供参考，修改了思路。。。

给力，刘版！之前的贴子我也写了，估计运行的速度楼主吼不住了，呵呵。学习了

jiangxiaoyun

powerquery也可以做

coden0906

liulang0808 发表于 2018-6-25 15:08

受教了，谢谢版主大神的思路，我好好研究消化下。。。

不知道为什么

coden0906 发表于 2018-6-25 21:50
受教了，谢谢版主大神的思路，我好好研究消化下。。。

他们的思路和共享，值得你送4朵花！