你有什么建议加快我的vba代码吗？
我使用UserForm让用户检查他想要分析的月份。
一旦用户确认他的选择，此代码将比较数据并在单元格中写入结果（如果找到了某些内容）。
现在，我需要38.7秒才能获得100分。
提前感谢您和最好的问候。
Private Sub Cmd1_Click()
Dim i As Long
Dim j As Long
Dim ult As Long
Dim myFrame As Control
Dim myCheck As Control
Dim StartTime As Double
Dim SecondsElapsed As Double
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ult = Worksheets("VendutoPassato").Range("B" & Rows.Count).End(xlUp).Row
StartTime = Timer
For i = 2 To 433
If Cells(i, 4) <> "" Then
For Each myFrame In Me.Controls
If TypeName(myFrame) = "Frame" Then
For Each myCheck In myFrame.Controls
If TypeName(myCheck) = "CheckBox" Then
If myCheck.Value = True Then
For j = 2 To ult
If Cells(i, 4) Like Worksheets("VendutoPassato").Cells(j, 1) And Worksheets("VendutoPassato").Cells(j, 3) Like Month(DateValue("02-" & myCheck.Caption & "-1992")) And Worksheets("VendutoPassato").Cells(j, 2) Like myFrame.Caption Then
Cells(i, 14) = Cells(i, 14) + Worksheets("VendutoPassato").Cells(j, 4)
End If
Next
End If
End If
Next
End If
Next
Else
If Cells(i, 3) <> "" Then
For Each myFrame In Me.Controls
If TypeName(myFrame) = "Frame" Then
For Each myCheck In myFrame.Controls
If TypeName(myCheck) = "CheckBox" Then
If myCheck.Value = True Then
For j = 2 To ult
If Cells(i, 3) Like Worksheets("VendutoPassato").Cells(j, 1) And Worksheets("VendutoPassato").Cells(j, 3) Like Month(DateValue("02-" & myCheck.Caption & "-1992")) And Worksheets("VendutoPassato").Cells(j, 2) Like myFrame.Caption Then
Cells(i, 14) = Cells(i, 14) + Worksheets("VendutoPassato").Cells(j, 4)
End If
Next
End If
End If
Next
End If
Next
End If
End If
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Unload UserForm1
End Sub
答案 0 :(得分：1)
尝试一下，应该快得多：
Private Sub Cmd1_Click()
Dim wb As Workbook
Dim wsData As Worksheet
Dim wsVenduto As Worksheet
Dim rVendutoData As Range
Dim myFrame As Control
Dim myCheck As Control
Dim aDataIDs As Variant
Dim aDataValues As Variant
Dim LastDataRow As Long
Dim DataIndex As Long
Dim vID As Variant
Dim StartTime As Double
Dim SecondsElapsed As Double
StartTime = Timer
With Application
.Calculation = xlCalculationManual
.EnableEvents = False
.ScreenUpdating = False
End With
Set wb = ActiveWorkbook
Set wsData = wb.ActiveSheet
Set wsVenduto = wb.Sheets("VendutoPassato")
Set rVendutoData = wsVenduto.Range("A2", wsVenduto.Cells(wsVenduto.Rows.Count, "A").End(xlUp))
LastDataRow = wsData.Range("C:D").Find("*", wsData.Range("C1"), xlValues, xlWhole, , xlPrevious).Row
aDataIDs = wsData.Range("C2:D" & LastDataRow).Value
aDataValues = wsData.Range("N2").Resize(UBound(aDataIDs, 1) - LBound(aDataIDs, 1) + 1).Value
For DataIndex = LBound(aDataIDs, 1) To UBound(aDataIDs, 1)
vID = vbNullString
Select Case Abs((aDataIDs(DataIndex, 2) = "")) + Abs(2 * (aDataIDs(DataIndex, 1) = ""))
Case 0, 2: vID = aDataIDs(DataIndex, 2)
Case 1: vID = aDataIDs(DataIndex, 1)
End Select
If Len(vID) > 0 Then
For Each myFrame In Me.Controls
If TypeOf myFrame Is Frame Then
For Each myCheck In myFrame.Controls
If TypeName(myCheck) = "CheckBox" Then
If myCheck.Value = True Then
aDataValues(DataIndex, 1) = aDataValues(DataIndex, 1) + WorksheetFunction.SumIfs(rVendutoData.Offset(, 3), _
rVendutoData, vID, _
rVendutoData.Offset(, 1), myFrame.Caption, _
rVendutoData.Offset(, 2), myCheck.Caption)
End If
End If
Next myCheck
End If
Next myFrame
End If
Next DataIndex
wsData.Range("N2").Resize(UBound(aDataValues, 1) - LBound(aDataValues, 1) + 1).Value = aDataValues
With Application
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.ScreenUpdating = True
End With
Unload UserForm1
SecondsElapsed = Timer - StartTime
MsgBox "Completed successfully in " & SecondsElapsed & " seconds."
End Sub
答案 1 :(得分：0)
为了回答这样的问题，您应该知道执行的最长时间在哪里。我建议这是在Excel文件中写入的过程：
Cells(i, 14) = Cells(i, 14) + Worksheets("VendutoPassato").Cells(j, 4)
Cells(i, 14) = Cells(i, 14) + Worksheets("VendutoPassato").Cells(j, 4)
因此，最好对这些行进行评论，看看它是否足够快。如果速度是好的，那么尝试制作一些结构，记住应该写什么东西和应该写什么。例如某种对象，它记得Cells(i, 14) + Worksheets("VendutoPassato").Cells(j, 4)应该写在Cells(i, 14)中。
完成后，尝试在任务结束时立即编写所有内容。假设它应该更快。
答案 2 :(得分：0)
根据@tehhowch和@Middle的建议，我设法做了一些重大改进。
现在需要8.75秒才能让我达到100。
如果你们知道如何进一步优化它，那么欢迎你！
Private Sub Cmd1_Click()
Dim i As Long
Dim j As Long
Dim ult As Long
Dim myFrame As Control
Dim myCheck As Control
Dim StartTime As Double
Dim SecondsElapsed As Double
Dim arr As Variant
Dim arrx As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
ult = Worksheets("VendutoPassato").Range("B" & Rows.Count).End(xlUp).Row
arr = Worksheets("VendutoPassato").Range("A2:D" & ult)
arrx = Worksheets("Foglio1").Range("C2:D433")
For i = 1 To 432
If arrx(i, 2) <> "" Then
For Each myFrame In Me.Controls
If TypeName(myFrame) = "Frame" Then
For Each myCheck In myFrame.Controls
If TypeName(myCheck) = "CheckBox" Then
If myCheck.Value = True Then
For j = 1 To ult - 1
If arrx(i, 2) Like arr(j, 1) And arr(j, 3) Like Month(DateValue("02-" & myCheck.Caption & "-1992")) And arr(j, 2) Like myFrame.Caption Then
Cells(i + 1, 14) = Cells(i + 1, 14) + arr(j, 4)
Exit For
End If
Next
End If
End If
Next
End If
Next
Else
If arrx(i, 1) <> "" Then
For Each myFrame In Me.Controls
If TypeName(myFrame) = "Frame" Then
For Each myCheck In myFrame.Controls
If TypeName(myCheck) = "CheckBox" Then
If myCheck.Value = True Then
For j = 1 To ult - 1
If arrx(i, 1) Like arr(j, 1) And arr(j, 3) Like Month(DateValue("02-" & myCheck.Caption & "-1992")) And arr(j, 2) Like myFrame.Caption Then
Cells(i, 14) = Cells(i, 14) + arr(j, 4)
Exit For
End If
Next
End If
End If
Next
End If
Next
End If
End If
Next
Application.EnableEvents = True
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Unload UserForm1
End Sub