Question

我有这个宏，终于搞清楚了，但它运行得很慢，需要大约3天才能通过我的一张80万行，而且我有100张。在这方面，我将不胜感激。

Sub Calculate_Sheet()
   Dim orderSh As Worksheet
   Dim wiroSh As Worksheet
   Dim lastRow As Long, r As Long
   Dim pctComp As Double

 With ThisWorkbook
  'calculator
  Set orderSh = .Sheets("ORDER")
  'price list
  Set wiroSh = .Sheets("WiroA3C100gsmI100gsm20-22pp ")
End With

lastRow = wiroSh.Cells(Rows.Count, 3).End(xlUp).Row

For r = 2 To lastRow
pctComp = (r / 800000) * 100
Application.StatusBar = "Progress..." & " " & pctComp & " " & "% Complete"

  'copy from price list to calculator
  orderSh.Range("f4") = wiroSh.Range("c" & r)
  orderSh.Range("f5") = wiroSh.Range("d" & r)
  orderSh.Range("f6") = wiroSh.Range("e" & r)
  orderSh.Range("f7") = wiroSh.Range("f" & r)
  orderSh.Range("f8") = wiroSh.Range("g" & r)
  orderSh.Range("f9") = wiroSh.Range("h" & r)
  orderSh.Range("f10") = wiroSh.Range("i" & r)
  orderSh.Range("f11") = wiroSh.Range("j" & r)
  orderSh.Range("f12") = wiroSh.Range("k" & r)
  orderSh.Range("f13") = wiroSh.Range("l" & r)

  'copy result
  wiroSh.Range("m" & r).Value = orderSh.Range("F14")
Next r

 End Sub

Answer 1

此外，您可以尝试仅复制单个范围，而不是多个范围。我认为它可以略微提高你的表现。

我想，你可以替换这个

  orderSh.Range("f4") = wiroSh.Range("c" & r)
  orderSh.Range("f5") = wiroSh.Range("d" & r)
  orderSh.Range("f6") = wiroSh.Range("e" & r)
  orderSh.Range("f7") = wiroSh.Range("f" & r)
  orderSh.Range("f8") = wiroSh.Range("g" & r)
  orderSh.Range("f9") = wiroSh.Range("h" & r)
  orderSh.Range("f10") = wiroSh.Range("i" & r)
  orderSh.Range("f11") = wiroSh.Range("j" & r)
  orderSh.Range("f12") = wiroSh.Range("k" & r)
  orderSh.Range("f13") = wiroSh.Range("l" & r)

有这样的东西

orderSh.Range(orderSh.cells(4,"F"),orderSh.cells(13,"F")) = wiroSh.Range(wiroSh.cells(r,"C"),wiroSh.cells(r,"l"))

正如j.kaspar所提到的，使用application.screenupdating = false是个好主意，但我强烈建议在宏的开头使用这样的东西

Dim previousScreenUpdating as boolean
previousScreenUpdating = application.screenUpdating
application.screenUpdating = false

这是宏的结尾

application.screenUpdating = previousScreenUpdating

当你有嵌套功能时，可以帮助你设置多个screenUpdatings ......

而且，如果你在任何一张纸上都有一些公式，那就用（在开头的）

做一些类似的东西

Application.Calculation = xlCalculationManual

，这在代码的末尾

Application.Calculation = xlCalculationAutomatic

最后，如果你有一些事件监听器，请考虑使用它（与屏幕更新相同）

application.enableEvents

Answer 2

在开头使用Application.ScreenUpdating = False，在宏的末尾使用Application.ScreenUpdating = True。

当屏幕未更新时，它将运行多倍。但请记住，800.000行和100张是很多的，它需要＆＃34;一些＆＃34;时间...

Answer 3

excel中有一个名为“数据表”的功能。此功能可以帮助您而无需编写VBA。但是，对不起，我用英语找不到解释。

Answer 4

绝对没有理由关闭屏幕更新。它是一种用于加速低效代码的技术，如果您的代码效率低下，您不必担心屏幕更新....永远......

理论很简单..除非绝对必要，否则不要在代码中访问/使用范围......

而是将整个工作表数据转储到一个数组中并从中工作，不仅速度快......我的意思是超快，你可以立即使用一个重新填充整个工作表（即32000列和100万行）阵列......

并使用完全相同的逻辑来处理数组，就像使用范围一样，所以你真的没有任何借口..

Dim Arr as variant
Arr = Sheet1.Range("A1:Z100")

现在代替Sheet1.Range（＆＃34; A1＆＃34;）。值只使用Arr（1,1）来访问值

使用数组更新工作表同样容易

Sheet1.Range("A1:Z100").value = arr

它就这么简单，它的速度很快，它应该是你应该这样做的方式，除非它只是你工作的小东西，但即便如此，最好还是练习最好的方法吗？

要注意的一件事是当你将数组值放回到工作表时，你需要使用一个与数组相同或更大的范围........否则它只会填充您指定的范围。

Answer 5

所以我接受了阵列的建议，但我遗漏了一些东西。这是我如何调整VBA代码，没有任何值被插入任何地方？

 Sub Calculate_Sheet()

Dim orderSh As Worksheet
Dim wiroSh As Worksheet
Dim lastRow As Long, r As Long
Dim pctComp As Double
Dim Arr1 As Variant
Dim Arr2 As Variant

With ThisWorkbook

'calculator
  Set orderSh = .Sheets("ORDER")

'price list
  Set wiroSh = .Sheets("WiroA3C100gsmI100gsm20-22pp ")

 End With

 Arr1 = wiroSh.Range("C1:M800001")
 Arr2 = orderSh.Range("F4:F14")

lastRow = wiroSh.Cells(Rows.Count, 3).End(xlUp).Row

For r = 2 To lastRow

'display the row and percentage each 1000 rows
  If r Mod 1 = 0 Then
     Application.StatusBar = "Row = " & r & Format(r / lastRow, " #0.00%")
  End If

'copy from price list to calculator
  Arr2(1, 1) = Arr1(r, 1)
  Arr2(2, 1) = Arr1(r, 2)
  Arr2(3, 1) = Arr1(r, 3)
  Arr2(4, 1) = Arr1(r, 4)
  Arr2(5, 1) = Arr1(r, 5)
  Arr2(6, 1) = Arr1(r, 6)
  Arr2(7, 1) = Arr1(r, 7)
  Arr2(8, 1) = Arr1(r, 8)
  Arr2(9, 1) = Arr1(r, 9)
  Arr2(10, 1) = Arr1(r, 10)

'copy result
  Arr1(r, 11) = Arr2(11, 1)

Next r


 End Sub

VBA宏运行速度非常慢

5 个答案: