Question

我在VBA中有一个Do Until循环。

我的问题是，在运行宏的大多数日子里可能会出现错误，因为并非所有工作表都有关于它们的信息。

当发生这种情况时，我只想再次启动循环。我假设它不是“On Error Resume Next”我正在考虑计算自动过滤器上的行，然后是否为1（即只有标题）再次启动循环。只是不知道该怎么做。

Dim rngDates As Range'粘贴日期的范围。 'Dim strDate As String Dim intNoOfRows As Integer Dim rng As Range

Sub Dates()

Application.ScreenUpdating = False


Set rngWorksheetNames = Worksheets("info sheet").Range("a1")


dbleDate = Worksheets("front sheet").Range("f13")


Worksheets("info sheet").Activate
Range("a1").Activate

Do Until ActiveCell = ""

strSheet = ActiveCell

Set wsFiltering = Worksheets(strSheet)

intLastRow = wsFiltering.Cells(Rows.Count, "b").End(xlUp).Row

Set rngFilter = wsFiltering.Range("a1:a" & intLastRow)

With rngFilter

.AutoFilter Field:=1, Criteria1:="="

On Error Resume Next

Set rngDates = .Resize(.Rows.Count - 1, 1).Offset(1, 0).SpecialCells(xlCellTypeVisible)


End With

With rngDates
.Value = dbleDate
.NumberFormat = "dd/mm/yyyy"

If wsFiltering.FilterMode Then
wsFiltering.ShowAllData
End If

ActiveCell.Offset(1, 0).Select

End With

Application.ScreenUpdating = True

Worksheets("front sheet").Select

MsgBox ("Dates updated")

Loop

Answer 1

您可以使用SUBTOTAL公式检查过滤后的数据存在。

If Application.WorkSheetFunction.Subtotal(103,ActiveSheet.Columns(1)) > 1 Then

'There is data

Else

'There is no data (just header row)

End If

您可以阅读有关SUBTOTAL here

的信息

不要使用Do Until循环，而是考虑在Worksheets Collection上使用For Each循环。

即

Sub ForEachWorksheetExample()

    Dim sht As Worksheet

    'go to error handler if there is an error
    On Error GoTo err

        'loop through all the worksheets in this workbook
        For Each sht In ThisWorkbook.Worksheets

            'excute code if the sheet is not the summary page
            'and if there is some data in the worksheet (CountA)
            '(this may have to be adjusted if you have header rows)
            If sht.Name <> "front sheet" And _
            Application.WorksheetFunction.CountA(sht.Cells) > 0 Then

            'do some stuff in here. Refer to sht as the current worksheet

            End If

        Next sht

    Exit Sub

err:
    MsgBox err.Description

End Sub

另外。我建议删除On Error Resume Next 语句。处理检测和处理错误而不是忽略它们要好得多。这可能会导致奇怪的结果。

Do Until循环需要在出错时重启

1 个答案: