Question

尝试搜索，但似乎没有具体回答我之后的事情。

由于某种原因，似乎代码运行得太快并且跳过了IF部分中的代码。

到目前为止，我已经尝试添加Application.Wait，创建一个单独的sub，其中包含要调用的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

Answer 1

您有With sourceSheet但在该区块内，您的范围引用都没有限定为With。例如

If Cells(iCntr, 2).Interior.ColorIndex = 3 Then

应该是

If .Cells(iCntr, 2).Interior.ColorIndex = 3 Then

检查所有其他范围参考以了解类似问题。

无法按预期工作的代码有时会在单步执行时起作用：这通常是因为在任何给定点上的activeworkbook与直接运行时的不同。这就是为什么每个范围/工作表参考应该完全有资格消除任何歧义。

Answer 2

Application.Calculation = xlManual是您的问题 - 函数和格式不会更新，因此您的if语句无法正常启动。

在问题行之前添加Application.CalculateFull，它应该可以正常工作。

Excel VBA For循环运行速度太快？跳过删除行

2 个答案: