VBAノック5本目：セルの計算 - 和風スパゲティのレシピ

Excel&VBA解説サイト「エクセルの神髄」様出題の問題集、
「VBA100本ノック」に対する私の回答と解説のページです。

100本ノックの出題リストはこちらから
excel-ubara.com

出題：セルの計算
ソースコード
解説

出題：セルの計算

#VBA100本ノック 5本目
画像のようにB2から始まる表があります。
B列×C列を計算した値をD列に入れ、通貨\のカンマ編集で表示してください。
ただしB列またはC列が空欄の場合は空欄表示にしてください。
例.D3にはB3×C3の計算結果の値を「\234,099」で表示、D5は空欄
※ブック・シートは任意

データサンプル

◇ 出題ページはこちら

ソースコード

定義モジュール

Option Explicit

' データ
Public Const R1stデータ = 3
Public Const C1stデータ = 2
Public Enum CNoデータ
    単価 = C1stデータ
    点数
    金額
End Enum
Public Const CLastデータ = CNoデータ.金額

メインモジュール

Option Explicit

' 100本ノック005：セルの計算
Sub 金額を計算する()
    With WSデータ
        
        .Columns(CNoデータ.金額).NumberFormatLocal = "\#,##0"
    
        Dim R As Long
        For R = R1stデータ To Get最終行(WSデータ)
        
            If .Cells(R, CNoデータ.単価) = "" Or _
               .Cells(R, CNoデータ.点数) = "" Then
                .Cells(R, CNoデータ.金額) = ""
            Else
                .Cells(R, CNoデータ.金額) = .Cells(R, CNoデータ.単価) _
                                          * .Cells(R, CNoデータ.点数)
            End If
        
        Next
    
    End With
End Sub

汎用関数モジュール

Option Explicit

' 最終行の取得
' 参考：https://www.limecode.jp/entry/library/get-lastrow-lastcolumn
Function Get最終行(指定オブジェクト As Variant, Optional ByVal C As Long = -1) As Long

    ' 渡されたオブジェクトからセル範囲を取得
    Dim 対象セル範囲 As Range
    Select Case TypeName(指定オブジェクト)
    Case "Range"
        If 指定オブジェクト.Cells.CountLarge = 1 Then ' 単独セルにはCurrentRegionを取る
            Set 対象セル範囲 = 指定オブジェクト.CurrentRegion
        Else
            Set 対象セル範囲 = 指定オブジェクト
        End If
    Case "Worksheet"
        Set 対象セル範囲 = 指定オブジェクト.UsedRange
    Case "AutoFilter", "ListObject"
        Set 対象セル範囲 = 指定オブジェクト.Range
    Case Else
        Err.Raise 1000, , "対象外のオブジェクト「" & TypeName(指定オブジェクト) & "」が指定されました。"
    End Select

    ' エリアの最終行を取得
    Get最終行 = 対象セル範囲.Rows.Count + 対象セル範囲.Row - 1

    ' 列が指定されていればその列の入力最終行を取得
    If C <> -1 Then
        Do While 対象セル範囲.Worksheet.Cells(Get最終行, C) = ""
            Get最終行 = Get最終行 - 1
            If Get最終行 < 対象セル範囲.Row Then
                Get最終行 = 0
                Exit Function
            End If
        Loop
    End If

End Function

メインモジュール

Sub 金額を計算する_Formula版()
    
    Dim 金額計算エリア As Range
    Set 金額計算エリア = WSデータ.Range("D3:D" & Get最終行(WS成績表))
    
    金額計算エリア.Formula = "=IF(OR(B3="""",C3=""""),"""",B3*C3)"
    金額計算エリア.Value = 合否計算エリア.Value
    
    金額計算エリア.NumberFormatLocal = "\#,##0"
    
End Sub