怎么优化代码

kulagen

在一个工作簿里有两张表；sheet2用VBA公式取销量等材料表的数据；代码如下；
这三段怎么循环？
如果要cells里的列+18循环到363后结束？；从E循环到相应的次数后结束？怎么做循环公式？怎么优化代码


Sheet2.Cells(4, 3) = "=SUMPRODUCT((C$3=销量等材料!$ad$3:$ad$8000)*($A4=销量等材料!$z$3:$z$8000)*(销量等材料!$e$3:$e$8000))"
    Range("C4").Select
    Selection.AutoFill Destination:=Range("C4:t4"), Type:=xlFillDefault
    Range("C4:t4").Select
    Selection.AutoFill Destination:=Range("C4:t203"), Type:=xlFillDefault
    Range("C4:t203").Select
    Selection.Copy '复制
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False '数值化
    Application.CutCopyMode = False 'ESC

Sheet2.Cells(4, 21) = "=SUMPRODUCT((C$3=销量等材料!$ad$3:$ad$8000)*($A4=销量等材料!$z$3:$z$8000)*(销量等材料!$f$3:$f$8000))"
    Range("u4").Select
    Selection.AutoFill Destination:=Range("u4:al4"), Type:=xlFillDefault
    Range("u4:al4").Select
    Selection.AutoFill Destination:=Range("u4:al203"), Type:=xlFillDefault
    Range("u4:al203").Select
    Selection.Copy '复制
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False '数值化
    Application.CutCopyMode = False 'ESC

Sheet2.Cells(4, 39) = "=SUMPRODUCT((C$3=销量等材料!$ad$3:$ad$8000)*($A4=销量等材料!$z$3:$z$8000)*(销量等材料!$g$3:$g$8000))"
     Range("am4").Select
     Selection.AutoFill Destination:=Range("am4:bd4"), Type:=xlFillDefault
     Range("am4:bd4").Select
     Selection.AutoFill Destination:=Range("am4:bd203"), Type:=xlFillDefault
     Range("am4:bd203").Select
     Selection.Copy '复制
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False '数值化
     Application.CutCopyMode = False 'ESC

Sheet2.Cells(4, 57) = "=SUMPRODUCT((C$3=销量等材料!$ad$3:$ad$8000)*($A4=销量等材料!$z$3:$z$8000)*(销量等材料!$h$3:$h$8000))"
     Range("be4").Select
     Selection.AutoFill Destination:=Range("be4:bv4"), Type:=xlFillDefault
     Range("be4:bv4").Select
     Selection.AutoFill Destination:=Range("be4:bv203"), Type:=xlFillDefault
     Range("be4:bv203").Select
     Selection.Copy '复制
     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False '数值化
     Application.CutCopyMode = False 'ESC

machunze

for r=3 to 363 step 18 这样，至于你的列变化是在公式里，那么需要把你的公式改成R1C1引用格式，循环C后面的数字就是了。

yylucke

你的代码完全是录制的宏，看起来太累
不如你整理一下基础数据，说明数据运算方法，同时举个例子，别人帮你重新写代码。

yylucke

问题：
1、既然动用了VBA，尽量不要用函数，那样工作表运算奇慢，《销量等材料》表中检查校验最好换成代码完成。
2、《品名资料》表中貌似有问题：产品1难道只能对应区域1？有无可能产品1对应区域2、区域3等，如果是，那你的《销量等材料》表中检查校验用vlookup函数就是错误的结果。
3、《品名资料》表中“区域”是恒定的？还是会动态增加的？
4、《销量等材料》表中Z列是录入的，还是从《品名资料》表中抓取的？
5、预留字段做什么？既然用VBA了，那么结果表《销量等材料提取》可以动态生成，没必要预留，否则造成《销量等材料提取》爆大无比。
6、看了你的计算过程，完全可以用函数解决（前提是：你不怕运算奇慢无比，不怕你的电脑宕机）
C4单元格公式，拖拽填充
=SUMPRODUCT((C$3=销量等材料!$AD$3:$AD$8000)*($A4=销量等材料!$Z$3:$Z$8000)*(OFFSET(销量等材料!$A$3,0,MATCH(C$2,销量等材料!$2:$2,0)-1,7998,1)))

kulagen

yylucke 发表于 2019-9-11 15:31
问题：
1、既然动用了VBA，尽量不要用函数，那样工作表运算奇慢，《销量等材料》表中检查校验最好换成代码 ...

就是把《销量等材料》表的数据转化为提取表里的数；重新写个VBA怎么弄？公式弄的话因为数据大很慢的

kulagen

machunze 发表于 2019-9-11 12:35
for r=3 to 363 step 18 这样，至于你的列变化是在公式里，那么需要把你的公式改成R1C1引用格式，循环C后面 ...

求解怎么破

machunze

kulagen 发表于 2019-10-27 11:32
求解怎么破

一般思路不按你那么破，用字典，下面是个简单的程序，仍然有点费时间。
Sub 录入销量()


If MsgBox("  录入销量(箱) " & vbNewLine & "  这只要一点时间", vbYesNo) <> vbYes Then Exit Sub

Dim d As Object, i&, j&
Set d = CreateObject("scripting.dictionary")
With Sheets("销量等材料")
    For i = 3 To .[a65536].End(xlUp).Row
        For j = 4 To 25
            d(.Cells(i, 1).Value & .Cells(2, j).Value & .Cells(i, 26).Value) = _
             d(.Cells(i, 1).Value & .Cells(2, j).Value & .Cells(i, 26).Value) + .Cells(i, j).Value
        Next
    Next
End With
            
Dim k&, p&
With Sheets("销量等材料提取")
    For k = 4 To .[a65536].End(xlUp).Row
        For p = 3 To .[iiv2].End(xlToLeft).Column
            If d.exists(.Cells(3, p).Value & .Cells(2, p).Value & .Cells(k, 1).Value) Then
                .Cells(k, p) = d(.Cells(3, p).Value & .Cells(2, p).Value & .Cells(k, 1).Value)
            Else
                .Cells(k, p) = 0
            End If
        Next
    Next
End With

MsgBox "  导入结束注意核对"
End Sub