无法用Excel VBA创build有效的退出条件
首先发布所有，所以原谅任何语法错误：我一直在工作电子表格很长一段时间。 其目的是logging我的电话，因为我在一个大容量的入境宾客服务呼叫中心工作。 有时我需要跟进我的客人。
工作表是列A：K，从第5行开始
最终，我编写了一个程序来检查我的logging，忽略任何有K列数据的行，然后当它find有效的数据时，将这些logging复制到另一个工作表，然后回到主工作表。 这部分工作正常，这里是代码：
Sub Button2_Click() Dim sourceEmptyRow As Long Dim targetEmptyRow As Long Dim sourceRange As Range Dim targetRange As Range 'Make Today active Sheet1.Activate 'Set Variables sourceEmptyRow = FindNextEmpty(Range("K5")).Row Set sourceRange = Rows(sourceEmptyRow) sourceRange.Copy 'Activate Next Sheet sheetQ4.Activate 'Set Variables targetEmptyRow = FindNextEmpty(Range("A1")).Row Set targetRange = Rows(targetEmptyRow) targetRange.PasteSpecial Sheet1.Activate sourceRange.Delete Shift:=xlUp End Sub 这里是FindNextEmpty（）函数（我很确定我在这里find了）
Public Function FindNextEmpty(ByVal rCell As Range) As Range 'Finds the first empty cell downwards in a column. On Error GoTo ErrorHandle With rCell 'If the start cell is empty it is the first empty cell. If Len(.Formula) = 0 Then Set FindNextEmpty = rCell 'If the cell just below is empty ElseIf Len(.Offset(1, 0).Formula) = 0 Then Set FindNextEmpty = .Offset(1, 0) Else 'Finds the last cell with content. '.End(xlDown) is like pressing CTRL + arrow down. Set FindNextEmpty = .End(xlDown).Offset(1, 0) End If End With Exit Function ErrorHandle: MsgBox Err.Description & ", Function FindNextEmpty." End Function
我的问题是，我希望能够执行这个代码块，然后当它完成时，检查下一行…如果两列A和K是空白的停止，否则循环回顶部，并执行它下一行。 如果我有一个漫长的一天，我有时可以得到20-30个电话，而按下20-30个button效率不高。
自2003年以来，我没有严格的编码，所以我是一个极端的新手。 感谢您提供的任何帮助，想法和见解。
这是我的电子表格
这使用AutoFilter
Option Explicit Public Sub MoveCompleted() Const COL_K = 11 Const TOP_ROW = 5 Dim ws1 As Worksheet: Set ws1 = sheetToday '<--- Source sheet Dim ws2 As Worksheet: Set ws2 = sheetQ118 '<--- Destination sheet Dim maxRows As Long, ws1ur As Range optimizeXL True With ws1.UsedRange If ws1.AutoFilterMode Then .AutoFilter maxRows = .Rows.Count .Offset(TOP_ROW - 2).Resize(maxRows - (TOP_ROW - 2)).AutoFilter 'ur + header row .AutoFilter Field:=COL_K, Criteria1:="=" 'show only blanks in K Set ws1ur = .Offset(TOP_ROW - 1).Resize(maxRows - TOP_ROW + 1, .Columns.Count) On Error Resume Next Set ws1ur = ws1ur.SpecialCells(xlCellTypeVisible) If Err.Number <> 0 Then Err.Clear Else ws1ur.Copy ws2.Cells(Rows.Count, 1).End(xlUp).Offset(1) ws1ur.EntireRow.Delete End If On Error GoTo 0 .AutoFilter Field:=COL_K End With optimizeXL False End Sub
Public Sub optimizeXL(Optional ByVal settingsOff As Boolean = True) With Application .ScreenUpdating = Not settingsOff .Calculation = IIf(settingsOff, xlCalculationManual, xlCalculationAutomatic) .EnableEvents = Not settingsOff End With End Sub
初始testing表
工作表Sheet1 
sheetQ4 
结果
工作表Sheet1 
sheetQ4 