【发布时间】：2018-04-16 19:21:39
【问题描述】：
尝试搜索，但似乎没有什么能具体回答我所追求的..
由于某种原因，代码似乎运行得太快并跳过了 IF 部分中的代码。
到目前为止，我已经尝试添加 Application.Wait，创建一个带有 IF 代码的单独子程序，以降低其速度。没有任何事情被证明是成功的。
基本目的是导入工作表，将其复制到活动工作簿，然后删除红色的行并通过删除导入的工作表完成。
除了红色行保留在目标工作表上之外，一切正常。
使用 F8 逐步完成该过程会产生成功的结果！
Sub Grab_Data()
'FOR THE DEBUG TIMER
Dim StartTime As Double
Dim MinutesElapsed As String
Application.ScreenUpdating = False
Application.Calculation = xlManual
Application.DisplayAlerts = False
Dim targetWorkbook As Workbook
'Assume active workbook as the destination workbook
Set targetWorkbook = Application.ActiveWorkbook
'Import the Metadata
Dim sImportFile As String, sFile As String
Dim sThisBk As Workbook
Dim vfilename As Variant
Set sThisBk = ActiveWorkbook
sImportFile = Application.GetOpenFilename( _
FileFilter:="Microsoft Excel Workbooks, *.xlsm; *.xlsx", Title:="Open
Workbook")
If sImportFile = "False" Then
MsgBox "No File Selected!"
Exit Sub
Else
vfilename = Split(sImportFile, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=sImportFile
StartTime = Timer
Set wbBk = Workbooks(sFile)
With wbBk
'COPY TV SHOWS SHEET
If SheetExists("TV") Then
Set wsSht = .Sheets("TV")
wsSht.Copy after:=sThisBk.Sheets(Sheets.Count)
ActiveSheet.Name = "TV 2"
Else
MsgBox "There is no sheet with name :TV in:" & vbCr & .Name
End If
wbBk.Close SaveChanges:=False
End With
End If
Set wsSht = Nothing
Set sThisBk = Nothing
'#########TV##########
'Set sheets to TV
Dim targetSheet As Worksheet
Set targetSheet = targetWorkbook.Worksheets("TV")
Dim sourceSheet As Worksheet
Set sourceSheet = targetWorkbook.Worksheets("TV 2")
'Find Last Rows
Dim LastRow As Long
With sourceSheet
LastRow = .Cells(rows.Count, "A").End(xlUp).Row
End With
Dim LastRow2 As Long
With targetSheet
LastRow2 = .Cells(rows.Count, "C").End(xlUp).Row
End With
'Remove RED expired rows
With sourceSheet
For iCntr = LastRow To 1 Step -1
If Cells(iCntr, 2).Interior.ColorIndex = 3 Then
rows(iCntr).EntireRow.Delete
Debug.Print iCntr
End If
Next
End With
'Variables for TV
targetSheet.Range("B4:B" & LastRow).Value = sourceSheet.Range("E2:E" &
LastRow).Value
sourceSheet.Range("E2:E" & LastRow).Copy
targetSheet.Range("B4:B" & LastRow).PasteSpecial xlFormats
Set targetSheet = Nothing
Set sourceSheet = Nothing
'Delete imported sheets
With ActiveWorkbook
.Sheets("TV 2").Delete
.Sheets("Movies 2").Delete
.Sheets("Audio 2").Delete
End With
LastRow = Sheets("TV").Cells(rows.Count, "B").End(xlUp).Row
End With
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MinutesElapsed = Format((Timer - StartTime) / 86400, "hh:mm:ss")
MsgBox "This code ran successfully in " & MinutesElapsed & " minutes",
vbInformation
End Sub
Private Function SheetExists(sWSName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = Worksheets(sWSName)
If Not ws Is Nothing Then SheetExists = True
End Function
【问题讨论】：
-
相当肯定这是我第一次看到任何与 VBA 相关的东西被指责“太快”。
-
我以前也遇到过这种情况，我在它跳过的部分之前添加了一行以选择页面上的一个单元格并修复它。希望我能更好地解释原因，希望对您有所帮助。如果不正确，则通过实际使用 vba 打印要删除的单元格的颜色索引来确保颜色索引正确。
-
我从未见过这种情况发生在“正确”且不处理某种自动化的代码上。您的代码可能没有按照您的想法进行。
-
您拥有
With sourceSheet，但在该块内，您的范围引用均不限于With。例如If Cells(iCntr, 2).Interior.ColorIndex = 3 Then应该是If .Cells(iCntr, 2).Interior.ColorIndex = 3 Then -
代码有时会在单步执行时起作用，因为任何给定点的活动工作簿都与您直接执行时不同。这就是为什么每个范围/工作表引用都应该完全限定以消除任何歧义。