1

I have a Do Until loop in VBA.

My problem is that there is likely to be an error most days when running the macro as not all the sheets will have info on them.

When that happens I just want to start the loop again. I am assuming its not the "On Error Resume Next" I was thinking of counting the rows on the autofilter and then if it was 1 (ie only titles) starting the loop again. Just not sure how to do that.

Dim rngDates As Range 'range where date is pasted on. '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
4

1 回答 1

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

您可以在此处阅读有关小计的信息

不要使用Do Until循环，而是考虑For Each在工作表集合上使用循环。

IE。

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 声明。处理检测和处理错误比忽略它们要好得多。它可能会导致奇怪的结果。

于 2013-10-26T12:10:11.857 回答