Question

早上好SO社区。

我正在开发一份报告，其中包含2个现有报告并创建第三个摘要，我热衷于通过vba而不是手动过程执行每日创建任务。它有大约100K行，有几个vlookup和一个嵌套的sumif。在可能的情况下，我已经将最后一行定义为变量，并将其放入vlookups的范围内，以阻止它遍历所有百万个单元格，并且已经转向计算，屏幕更新等。

端到端宏需要大约15分钟才能运行并产生我想要的最终结果。但是，如果我单步执行每个单独的行，则该过程大约需要3分钟才能运行，最终结果是相同的。

并不是真的在寻找改进建议，因为它正在发挥作用（虽然它总是受欢迎的）但是试图理解为什么在踏入而不是跑步时它更快。

我已经包含了下面的全部代码，nb我在我设置的许多昏暗名称中以及工作簿和工作簿名称中使用了我的公司名称，所以为了保护公司，它已被“XXXX”取代

非常感谢

计划303

Sub processdata()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.DisplayAlerts = False

    Dim XXXXLen As Long
    With Sheets("Input - XXXXwebnew")
        XXXXLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'add concatenate ref column in column A on Input XXXXWebNew

    Sheets("INPUT - XXXXwebnew").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Sheets("INPUT - XXXXwebnew").Range("A1:A" & XXXXLen) = "=CONCATENATE(E1,""_"",G1,""_"",I1)"
    Application.Calculate
    Sheets("Input - XXXXwebnew").Range("a1:a" & XXXXLen).Copy
    Sheets("Input - XXXXwebnew").Range("a1:a" & XXXXLen).PasteSpecial xlPasteValues

    'picks up config products and moves them from E (input - XXXXwebnew) to to A on (workings) tab

    Workbooks("workingmodel.xlsm").Sheets("WORKINGS").Range("a2:a" & XXXXLen + 1).value _
        = Workbooks("workingmodel.xlsm").Sheets("INPUT - XXXXWebNew").Range("e1:e" & XXXXLen).value

    'picks up simple products and moves them from A (input - XXXXwebnew) to to A on (workings) tab

    'set a second dim which is the dim XXXXlen X2

    Dim XXXXlen2 As Long
    XXXXlen2 = XXXXLen + XXXXLen

    Workbooks("workingmodel.xlsm").Sheets("WORKINGS").Range("a" & XXXXLen + 2 & ":a" & XXXXlen2 + 1).value _
        = Workbooks("workingmodel.xlsm").Sheets("INPUT - XXXXWebNew").Range("a1:a" & XXXXLen).value

    'remove all duplicates

    Sheets("workings").Range("$A$1:$A$" & XXXXlen2 + 1).RemoveDuplicates Columns:=1, Header:=xlYes

    'dim set for Workings tab length of data

    Dim WorkLen As Long
    With Sheets("WORKINGS")
        WorkLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'brings first formula in, calculates, C&Psp

    Sheets("workings").Range("b2:b" & WorkLen) = "=IF(LEN(A2)=12,""CONFIG"",""SIMPLE"")"
    Application.Calculate
    Sheets("workings").Range("b2:b" & WorkLen).Copy
    Sheets("workings").Range("b2:b" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("c1") = "does it appear within XXXX_all(code means yes / #N/A means no)"

    'define lenght of XXXX_all
    Dim XXXXallLen As Long
    With Sheets("INPUT - XXXX_all")
        XXXXallLen = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With

    'building the various dimensions required for a dynamic vba vlookup

    Dim sheetXXXX_all As String
    sheetXXXX_all = "INPUT - XXXX_all"

    Dim XXXXalllookup As String
    XXXXalllookup = ("'" & sheetXXXX_all & "'!$A$1:$m$" & XXXXallLen)

    Sheets("workings").Range("c2:c" & WorkLen) = "=left(VLOOKUP(A2," & XXXXalllookup & ",1,FALSE),12)"
    Application.Calculate
    Sheets("workings").Range("c2:c" & WorkLen).Copy
    Sheets("workings").Range("c2:c" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("d1") = "is it enabled"


    Sheets("workings").Range("d2:d" & WorkLen) = "=VLOOKUP(A2," & XXXXalllookup & ",2,FALSE)"
    Application.Calculate
    Sheets("workings").Range("d2:d" & WorkLen).Copy
    Sheets("workings").Range("d2:d" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("e1") = "does it have an image 0 = no #N/A = product code doesn't exist"

    Sheets("workings").Range("e2:e" & WorkLen) = "=VLOOKUP(A2," & XXXXalllookup & ",4,FALSE)"
    Application.Calculate
    Sheets("workings").Range("e2:e" & WorkLen).Copy
    Sheets("workings").Range("e2:e" & WorkLen).PasteSpecial xlPasteValues


    'Sheets("workings").Range("f1") = "does description has a character"

    Sheets("workings").Range("f2:f" & WorkLen) = "=IF(LEN(VLOOKUP(A2," & XXXXalllookup & ",4,FALSE))=0,""NO DESC"",""FINE"")"
    Application.Calculate
    Sheets("workings").Range("f2:f" & WorkLen).Copy
    Sheets("workings").Range("f2:f" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("g1") = "RRRP Price"

    Sheets("workings").Range("g2:g" & WorkLen) = "=IF(VLOOKUP(A2," & XXXXalllookup & ",6,FALSE)<0.1,""NO PRICE"",""PRICE EXISTS"")"
    Application.Calculate
    Sheets("workings").Range("g2:g" & WorkLen).Copy
    Sheets("workings").Range("g2:g" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("h1") = "UK Price"

    Sheets("workings").Range("h2:h" & WorkLen) = "=IF(VLOOKUP(A2," & XXXXalllookup & ",13,FALSE)<0.1,""NO PRICE"",""PRICE EXISTS"")"
    Application.Calculate
    Sheets("workings").Range("h2:h" & WorkLen).Copy
    Sheets("workings").Range("h2:h" & WorkLen).PasteSpecial xlPasteValues

    'Sheets("workings").Range("I1") = "Current stock greater than 0"

    Sheets("workings").Range("i2:i" & WorkLen).FormulaR1C1 = "=IF(RC[-7]=""config"",IF(SUMIF('Input - XXXXwebnew'!C[-4],WORKINGS!RC[-8],'Input - XXXXwebnew'!C[11])<0.1,""NO STOCK"",""HAS STOCK""),IF(VLOOKUP(RC[-8],'Input - XXXXwebnew'!C[-8]:C[12],20,FALSE)>0,""HAS STOCK"",""NO STOCK""))"
    Application.Calculate
    Sheets("workings").Range("i2:i" & WorkLen).Copy
    Sheets("workings").Range("i2:i" & WorkLen).PasteSpecial xlPasteValues

    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.DisplayAlerts = True

End Sub

Answer 1

我并不自称在vba中表现出色 - 其他人在这里！但是下面的两个链接可以帮助您改进代码：

How to avoid using Select in Excel VBA macros

http://www.excelitems.com/2010/12/optimize-vba-code-for-faster-macros.html

单步执行大约需要3分钟才能运行，但运行宏大约需要15分钟

1 个答案: