フィルタ抽出状態のセルにユーザー定義関数を入力、可視セルへコピー

Sub prcApplyFormulaWithCondition()
    ' 概要: D列が空白の場合にフィルタを適用し、条件に合致する可視セルのH列にユーザー定義関数を入力します。
    '       H列に数式を入力する前に、表示形式を「数値」に変更し、2行目から最終行までの不要な値をクリアします。
    
    Dim wksSheet As Worksheet ' シートを操作するための変数
    Dim lngLastRow As Long    ' データ範囲の最終行を格納するための変数
    Dim lngFirstRow As Long   ' 最初の可視行の行番号を格納するための変数
    Dim rngVisible As Range   ' 可視セル範囲を指定するための変数
    
    ' 対象のワークシートを設定
    Set wksSheet = ThisWorkbook.Sheets("Sheet1")
    
    With wksSheet
        ' 既存のフィルタをクリア
        If .AutoFilterMode Then .AutoFilter.ShowAllData
        
        ' H列の表示形式を数値に設定し、2行目から最終行までの値をクリア
        lngLastRow = .Cells(.Rows.Count, "H").End(xlUp).Row
        .Columns("H:H").NumberFormat = "General"
        .Range("H2:H" & lngLastRow).ClearContents
        
        ' D列が空白のデータにフィルタを適用
        .Range("A1").AutoFilter Field:=4, Criteria1:=""
        
        ' フィルタリングされた範囲の最初の可視行を特定し、行番号を取得
        Set rngVisible = .AutoFilter.Range.Offset(1, 0).SpecialCells(xlCellTypeVisible)
        lngFirstRow = rngVisible.Cells(1, 1).Row
        
        ' H列の最初の可視行にユーザー定義関数を設定し、同じ数式を可視セルの最終行までコピー
        rngVisible.EntireRow.Cells(1, "H").Formula = "=fncBlnTest(A" & lngFirstRow & ",B" & lngFirstRow & ")"
    End With
End Sub

コメント