1

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
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

すなわち。

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 に答える