【Excel VBA】乱数を発生させて対象の値の行を削除する方法(暇だったから...)

子どもが熱を出して会社を休むことになったので、引数を使って効率的にマクロを書くことを最近モヤモヤ考えていたので、作ってみた。

内容は、データシートに『処理シート名、処理開始行、処理終了行、処理列、消す値』を入力しておいて、それぞれ対象シートで乱数を発生させて消す値を探して行の削除を行うというもので、このままでは何の役にも立たないよぉ(笑)

変数名などが日本語にしておいたので、改造して使ってみてください。

処理時間の計測やステータスバーの表示など細かいところにこだわってみたので、参考にしてください。

前提条件は、①データシートを作ること、②データシートの処理シート名と実際のシート名が一致していること

苦労した点

 引数を渡す時にうまく動かなかったので、色々調べていたら、渡した引数には「参照渡し」と「値渡し」があり、特に指定しないで渡すと「参照渡し」になる。参照渡しになると渡した先で引数に変更を加えると戻り値も変更されてしまう。

 今回では変数代入マクロに引数を渡して「2」を足したので元の値が変わってしまったみたいだったので、「値渡し」にしました。そこで、受け取る側でSub 変数代入マクロ(ByVal カウント) と【ByVal】をつけることで値渡しにできます。

'変数の宣言
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

コメント

タイトルとURLをコピーしました