excel vba 超慢怎么提速?

2024-12-14 21:41:53

推荐回答（5个）

回答1：

VBA代码提速常用的方法主要有：

让代码"专注"运行
例如：将Application.ScreenUpdating设定为False,关闭屏幕更新
单元格（区域）写法的选择
单元格（区域）写法有3种,以A1单元格为例,使用Cell对象写法:cells(1,1)，运行速度最快
使用With语句
with语句不仅仅是简化了写法,速度也大大提升了。
尽量不用Variant类型
这不用多说吧,使用Option Explicit是一个好习惯。

回答2：

给你大概的提几点：
1、VBA中的在大量引用对象属性时如Sheets("顺风").Cells(j, 3)
可以 Set 顺风表=Sheets("顺风").Cells，然后用顺风表(j, 3)代替Sheets("顺风").Cells(j, 3)
这种引用，会提升速度的；
2、像这种类似数据比较的，也不在乎数据在单元格中位置的，可以把要比较的数据分别存到2个数组中，再比较，把需要提取到表三的数据，都得到后，再写入表三；
3、循环中应该增加个判断如果有匹配相同的，应该直接进入下层循环，后面的循环没有必要再执行
4、还有一个当你更新的数据中存在大量公式，可以把自动计算关闭，都更新后，再重新整体计算一下，对VBa执行速度也有很大提升；还有个就是你的Application.ScreenUpdating 界面更新也可以关闭，但一定要记住，函数执行完毕后，要恢复更新，要不EXcel就假死了

回答3：

Private Sub Worksheet_Activate()
Dim sh1 As Object, sh2 As Object
Dim app_cal As Long
app_cal = Application.Calculation
Application.Calculation = xlCalculationManual
'禁用公式自动更新,这是第一个可以加快百分之80的更改处
Set sh1 = Sheets("部门")
Set sh2 = Sheets("顺风")
'设置对象,以便直接引用各工作表,这是第二个可以加快10%的更改处

With sh2
For i = 3 To 32
For j = 8 To 800
x = j - 3
If sh1.Cells(i, 1) = .Cells(j, 17) Then
Cells(x, 9) = .Cells(j, 17)
Cells(x, 8) = .Cells(j, 16)
Cells(x, 7) = .Cells(j, 9)
Cells(x, 6) = .Cells(j, 8)
Cells(x, 5) = .Cells(j, 7)
Cells(x, 4) = .Cells(j, 5)
Cells(x, 3) = .Cells(j, 4)
Cells(x, 2) = .Cells(j, 3)
Cells(x, 1) = .Cells(j, 1)
'这一段应该还有改进的空间
'可以将所有数据赋值给二维数组，
'再在循环外将数组内容同仁给单元格区域
'但需要我了解一下你的表格的结构
'能这样改的话,还可以节省很多时间
End If
Next
Next
End With
Application.ScreenUpdating = app_cal
'恢复原始更新方式
End Sub
‘----------------------------我是可爱的分隔线-------------------------------------

'经过以上更改，你的这个代码应该可以闪过，1秒之内可以完成
’32*800次循环算什么，秒过

参考资料为：编写高效Excel VBA代码的最佳实践（看你编写的这些代码，确实不敢恭维,你应该参考一下)

回答4：

Private Sub Worksheet_Activate()
Dim iA, iB, rng3 As Range, tmp, i, j
Application.ScreenUpdating = False

'----获取数据，放入数组----
iA = Sheets("部门").Cells(3, 1).Resize(32 - 3 + 1, 1)
iB = Sheets("顺风").Cells(8, 1).Resize(800 - 8 + 1, 17)

'----定义放置结果的位置----
Set rng3 = Cells(5, 1).Resize(1, 9).Offset(-1, 0)

'----循环，放置数据----
With rng3
For i = LBound(iA, 1) To UBound(iA, 1)
For j = LBound(iB, 1) To UBound(iB, 1)
If iA(i, 1) = iB(j, 17) Then
tmp = Array(iB(j, 1), iB(j, 3), iB(j, 4), iB(j, 5), _
iB(j, 7), iB(j, 8), iB(j, 9), iB(j, 16), iB(j, 17))
.Offset(j) = tmp
End If
Next j, i
End With
Application.ScreenUpdating = True
End Sub
'---------
'可以使用字典，存储Sheets("部门")的数据，然后判断Sheets("顺风").的数据是否在字典中存在，然后复制数据，这样减少一层循环，会更快
'------------
Private Sub Worksheet_Activate1()
Dim d, c As Range, iB, r&, j
Application.EnableEvents = False
Application.ScreenUpdating = False

'----获取"部门"数据，放入字典----
Set d = CreateObject("Scripting.Dictionary")
For Each c In Sheets("部门").Cells(3, 1).Resize(32 - 3 + 1, 1)
d(CStr(c.Value)) = ""
Next

'----获取"顺风"数据，放入数组----
iB = Sheets("顺风").Cells(8, 1).Resize(800 - 8 + 1, 17)

r = 5 '行号，放置数据的第一行

For j = LBound(iB, 1) To UBound(iB, 1) '----循环，放置数据----
If d.Exists(CStr(iB(j, 17))) Then
Cells(r, 1).Resize(1, 9) = Array(iB(j, 1), iB(j, 3), iB(j, 4), _
iB(j, 5), iB(j, 7), iB(j, 8), iB(j, 9), iB(j, 16), iB(j, 17))
r = r + 1
End If
Next
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub

回答5：

算法先不看吧，有点累人的说，先给你两点建议你先试试：
1. 单元格赋值只取值，如Cells(x, 1) = Sheets("顺风").Cells(j, 1).value
2. Application.ScreenUpdating = False