子どもが熱を出して会社を休むことになったので、引数を使って効率的にマクロを書くことを最近モヤモヤ考えていたので、作ってみた。
内容は、データシートに『処理シート名、処理開始行、処理終了行、処理列、消す値』を入力しておいて、それぞれ対象シートで乱数を発生させて消す値を探して行の削除を行うというもので、このままでは何の役にも立たないよぉ(笑)
変数名などが日本語にしておいたので、改造して使ってみてください。
処理時間の計測やステータスバーの表示など細かいところにこだわってみたので、参考にしてください。
前提条件は、①データシートを作ること、②データシートの処理シート名と実際のシート名が一致していること
'変数の宣言
Dim Sh As Worksheet
Dim 開始行 As Long
Dim 終了行 As Long
Dim 処理列 As Long
Dim 対象値 As Long
Dim 削除カウント As Long
Dim 処理シート名 As String
Sub 変数代入マクロ(ByVal カウント)
参照行 = カウント + 2 '回数に2をたしてデータシートの参照行に合わせる
Set データシート = ThisWorkbook.Worksheets("データシート")
With データシート
処理シート名 = .Cells(参照行, 2) '処理シート名
開始行 = .Cells(参照行, 3) '開始行数
終了行 = .Cells(参照行, 4) '終了行数
処理列 = .Cells(参照行, 5) '処理列
対象値 = .Cells(参照行, 6) '消す値
End With
Set Sh = ThisWorkbook.Worksheets(処理シート名)
削除カウント = 0
End Sub
Sub 乱数作成マクロ()
startTime = Timer 'タイマースタート
With Sh
For n = 開始行 To 終了行
.Cells(n, 処理列) = Int(10 * Rnd + 1) '1~10までの乱数発生
If Int(n / 1000) = Int((n - 1) / 1000) Then '1,000件単位でステータスバー表示
Else
Call ステータスバー表示マクロ(n, "【乱数作成中】", "")
End If
Next
End With
endTime = Timer 'タイマーストップ
Application.StatusBar = False
MsgBox (開始行 & "行目~" & 終了行 & "行目まで処理した時間は、" _
& Application.WorksheetFunction.RoundDown(endTime - startTime, 2) & "秒でした。")
End Sub
Sub 行削除マクロ()
startTime = Timer 'タイマースタート
With Sh
For n = 終了行 To 開始行 Step -1
If .Cells(n, 処理列) = 対象値 Then
.Rows(n).Delete
削除カウント = 削除カウント + 1
Else
End If
If Int(n / 1000) = Int((n + 1) / 1000) Then '1,000件単位でステータスバー表示
Else
Call ステータスバー表示マクロ(終了行 - n - 1, "【削除中】", 削除カウント & "件削除済み ")
End If
Next
End With
endTime = Timer 'タイマーストップ
Application.StatusBar = False
MsgBox (対象値 & "を削除するのにかかった時間は、" _
& Application.WorksheetFunction.RoundDown(endTime - startTime, 2) & "秒でした。" _
& vbCrLf & 削除カウント & "件削除しました。")
End Sub
Sub ステータスバー表示マクロ(i, 表示, 削除件数)
Application.StatusBar = 表示 & i & "回目の処理をしています... " & 削除件数 & 処理シート名
End Sub
Sub 実行マクロ()
Application.ScreenUpdating = False
For i = 1 To 3
Call 変数代入マクロ(i)
Call 乱数作成マクロ
Call 行削除マクロ
Next
End Sub
コメント