VBA。我不知道如何成功退出我的 Do While 循环。我的宏完美地工作完成时出现错误

Question

Sub filterData()
    Dim filterCriteria As String
    x = 1
    Do While Not IsEmpty(filterCriteria)
        filterCriteria = (Sheets("Lists").Cells(x, 2))
        Sheets(filterCriteria).Select
        Sheets(filterCriteria).Cells.Clear

        Range("A1") = "Date"
        Range("B1") = "Item"
        Range("C1") = "Category"
        Range("D1") = "Quantity"
        Range("E1") = "Rate"
        Range("F1") = "Total"
        Range("A1:F1").Font.Bold = True
        Range("A1:F1").Font.ColorIndex = 5
        Sheets("BookEntry").Select
        Dim lastRow As Long

        lastRow = Sheets("BookEntry").Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByRows, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).row
        Dim lastColumn As Long

        lastColumn = Sheets("BookEntry").Cells.Find(What:="*", _
        After:=Range("A1"), _
        LookAt:=xlPart, _
        LookIn:=xlFormulas, _
        SearchOrder:=xlByColumns, _
        SearchDirection:=xlPrevious, _
        MatchCase:=False).Column

        Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3, Criteria1:=filterCriteria
        Sheets("BookEntry").Range(Cells(2, 1), Cells(lastRow, lastColumn)).Copy
        Sheets(filterCriteria).Select
        erow = Sheets(filterCriteria).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).row

        Sheets(filterCriteria).Paste Destination:=Worksheets(filterCriteria).Rows(erow)
        Sheets("BookEntry").Select
        Sheets("BookEntry").Range(Cells(1, 1), Cells(lastRow, lastColumn)).AutoFilter Field:=3
        ActiveWorkbook.Save
        x = x + 1
    Loop
End Sub

Answer 1

你犯了两个错误。

1- 您在分配前检查 filterCriteria。

2- 要检查空的 filterCriteria，您应该使用 Len(Trim(filterCriteria)) > 0 检查字符串，否则您应该将变量声明为变体，因为 IsEmpty 适用于变体。但是字符串选项更好。

将循环结构改成这样：

x = 1
Dim filterCriteria As String
filterCriteria = Sheets("Lists").Cells(x, 2).value

Do While Len(Trim(filterCriteria)) > 0
    ...
    ...
    x = x + 1
    filterCriteria = Sheets("Lists").Cells(x, 2).value
Loop

也尝试get rid of those .Select stuff。

VBA。我不知道如何成功退出我的 Do While 循环。我的宏完美地工作完成时出现错误

VBA. I can't figure out how to exit my Do While Loop successfully. My macro works perfecly the errors on completion

excel

vba

exit

do-while