我是VBA的新手，但是我设法编写了可以运行的代码。我的问题是，当我运行成千上万的行时，它基本上会停止运行，并且在一个多小时内没有任何反应（当我运行15万行时）。在我的代码之上，我添加了：
我还尝试尽可能避免使用.select。有什么我缺少的东西，或者有什么方法可以改善我的代码吗？因为我粘贴了各种代码，所以我确定我做错了什么。
Sub Eng11()
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Last As Long
Dim i As Long
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Dim lastrow As Long
Dim sPath As String, sFile As String
Dim wb As Workbook
Dim x As Long
Dim ws As Worksheet
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
sFile = sPath & Sheets("Sheet 1").Range("J2").Text
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open(sFile)
Set sht1 = wkb1.Sheets("Data Table")
Set sht2 = wkb2.Sheets("Sheet1")
Set ws = sht2
Last = Cells(Rows.Count, "AX").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
For i = Last To 2 Step -1
If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
End Sub
答案 0 :(得分：1)
我认为这是我所能做到的。当然，可以有一些逻辑魔术师来简化它，但是我认为他们可能无法将if逻辑放在一行上！
这只会循环一次，就运行时间而言，这应该是您最大的障碍。我确保指定您在sht2中进行搜索，删除了一些未使用的变量，并确保在子程序末尾重置application设置。除此之外，我唯一要做的就是尽我所能地合并您的if语句，并将它们放入一个循环中。
Sub Eng11()
With Application
.DisplayAlerts = False
.AskToUpdateLinks = False
.Calculation = xlCalculationManual
.ScreenUpdating = False
End With
Dim sht1 As Worksheet
Set sht1 = ThisWorkbook.Sheets("Data Table")
Dim sPath As String
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
Dim sFile As String
sFile = sPath & sht1.Range("J2").Value2
Dim sht2 As Worksheet
Set sht2 = Workbooks.Open(sFile).Sheets(1)
Dim lastRow As Long
lastRow = sht2.Cells(Rows.count, "AX").End(xlUp).row
Dim i As Long
For i = 2 To lastRow
With sht2
If .Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2 And _
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2 Then
If .Cells(i, "AY").Value2 = "C" And _
(.Cells(i, "AA").Value2 = "E" Or .Cells(i, "AA").Value2 = "T") Then
.Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
.Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
.Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2
End If
ElseIf .Cells(i, "AA").Value2 = "E" And _
(.Cells(i, "AY").Value2 = 2 Or .Cells(i, "AY").Value2 = 1) Then
.Cells(i, "AX").Value2 = .Cells(i, "Z").Value2
.Cells(i, "AY").Value2 = .Cells(i, "AA").Value2
.Cells(i, "AZ").Value2 = .Cells(i, "AB").Value2
.Cells(i, "BA").Value2 = .Cells(i, "AC").Value2
End If
End With
Next i
With Application
.DisplayAlerts = True
.AskToUpdateLinks = True
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
答案 1 :(得分：0)
Sub Eng11()
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Dim Last As Long
Dim i As Long
Dim wkb1 As Workbook
Dim sht1 As Worksheet
Dim wkb2 As Workbook
Dim sht2 As Worksheet
Dim lastrow As Long
Dim sPath As String, sFile As String
Dim wb As Workbook
Dim x As Long
Dim ws As Worksheet
sPath = "C:\Users\nascd\Downloads\Pronto Master\"
sFile = sPath & Sheets("Sheet 1").Range("J2").Text
Set wkb1 = ThisWorkbook
Set wkb2 = Workbooks.Open(sFile)
Set sht1 = wkb1.Sheets("Data Table")
Set sht2 = wkb2.Sheets("Sheet1")
Set ws = sht2
Last = Cells(Rows.Count, "AX").End(xlUp).Row
For i = Last To 2 Step -1
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AZ").Text) = (Cells(i, "AB").Text) And _
(Cells(i, "BA").Text) = (Cells(i, "AC").Text) And _
(Cells(i, "AY").Text) = "C" And (Cells(i, "AA").Text) = "T" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AY").Text) = "1" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
If (Cells(i, "AY").Text) = "2" And (Cells(i, "AA").Text) = "E" Then
Cells(i, "AX").Value = Cells(i, "Z").Value
Cells(i, "AY").Value = Cells(i, "AA").Value
Cells(i, "AZ").Value = Cells(i, "AB").Value
Cells(i, "BA").Value = Cells(i, "AC").Value
End If
Next i
End Sub
您能不能让我知道最后两个Ifs的区别，因为两个ifs条件的函数都相同。