Excel VBA | Excelで列数・行数を自動検出して掛け算表を生成するVBAマクロ

VBA
スポンサーリンク

以下のマクロは、シート上の状態に応じて完全自動で掛け算表を作ります。ヘッダー(上段と左列)が既にあればそれを読み取り、無ければ自動で1からの連番ヘッダーを作成します。サイズが判別できない場合は10×10で生成します。

Option Explicit

Sub GenerateAutoMultiplicationTable()
    Dim ws As Worksheet
    Set ws = ActiveSheet
    
    Dim lastRow As Long, lastCol As Long
    Dim m As Long, n As Long ' m=行数(左列の数), n=列数(上段の数)
    
    ' 現在の使用範囲を取得(空なら0)
    If ws.UsedRange Is Nothing Then
        lastRow = 0: lastCol = 0
    Else
        With ws.UsedRange
            lastRow = .Rows(.Rows.Count).Row
            lastCol = .Columns(.Columns.Count).Column
        End With
    End If
    
    ' 既存ヘッダーの自動判定
    ' 上段ヘッダーは B1 から右方向の連続数字、左列ヘッダーは A2 から下方向の連続数字を優先して読み取る
    n = DetectHeaderCountHorizontal(ws, Range("B1"))
    m = DetectHeaderCountVertical(ws, Range("A2"))
    
    ' ヘッダーが見つからない場合は、使用範囲から推定(B2 からの中身を表とみなす)
    If n = 0 Then
        If lastCol >= 2 Then
            n = lastCol - 1 ' B列から最終列まで
        End If
    End If
    If m = 0 Then
        If lastRow >= 2 Then
            m = lastRow - 1 ' 2行目から最終行まで
        End If
    End If
    
    ' それでもサイズが未確定ならデフォルト10×10
    If n = 0 Then n = 10
    If m = 0 Then m = 10
    
    ' 生成前に範囲をクリア(A1からヘッダー+表範囲)
    ws.Range(ws.Cells(1, 1), ws.Cells(m + 1, n + 1)).ClearContents
    
    ' ヘッダー生成:上段(B1..)、左列(A2..)
    Dim i As Long
    For i = 1 To n
        ws.Cells(1, 1 + i).Value = i ' B1から右へ
    Next i
    
    Dim j As Long
    For j = 1 To m
        ws.Cells(1 + j, 1).Value = j ' A2から下へ
    Next j
    
    ' 掛け算表の本体(B2..)
    Dim r As Long, c As Long
    For r = 1 To m
        For c = 1 To n
            ws.Cells(1 + r, 1 + c).Value = ws.Cells(1, 1 + c).Value * ws.Cells(1 + r, 1).Value
        Next c
    Next r
    
    ' 体裁を少し整える
    With ws.Range(ws.Cells(1, 1), ws.Cells(m + 1, n + 1))
        .Font.Name = "Meiryo"
        .Columns.AutoFit
        .Rows.RowHeight = 18
        .Borders.LineStyle = xlContinuous
    End With
    
    ' ヘッダーの書式
    With ws.Range(ws.Cells(1, 2), ws.Cells(1, n + 1))
        .Font.Bold = True
        .Interior.Color = RGB(235, 241, 222)
        .HorizontalAlignment = xlCenter
    End With
    With ws.Range(ws.Cells(2, 1), ws.Cells(m + 1, 1))
        .Font.Bold = True
        .Interior.Color = RGB(235, 241, 222)
        .HorizontalAlignment = xlCenter
    End With
    
    ' 本体整列
    With ws.Range(ws.Cells(2, 2), ws.Cells(m + 1, n + 1))
        .HorizontalAlignment = xlCenter
    End With
End Sub

Private Function DetectHeaderCountHorizontal(ws As Worksheet, startCell As Range) As Long
    ' B1から右に向けて、連続した数値ヘッダーの長さをカウント
    Dim col As Long, count As Long, val
    col = startCell.Column
    Do
        val = ws.Cells(startCell.Row, col).Value
        If IsNumeric(val) And val <> "" Then
            count = count + 1
            col = col + 1
        Else
            Exit Do
        End If
    Loop
    DetectHeaderCountHorizontal = count
End Function

Private Function DetectHeaderCountVertical(ws As Worksheet, startCell As Range) As Long
    ' A2から下に向けて、連続した数値ヘッダーの長さをカウント
    Dim row As Long, count As Long, val
    row = startCell.Row
    Do
        val = ws.Cells(row, startCell.Column).Value
        If IsNumeric(val) And val <> "" Then
            count = count + 1
            row = row + 1
        Else
            Exit Do
        End If
    Loop
    DetectHeaderCountVertical = count
End Function
VB

使い方

  • 完全自動: そのまま実行すると、B1右方向とA2下方向に既存の数値ヘッダーがあればそれを読み取り、無ければ10×10で生成します。既にデータがあれば使用範囲からサイズを推定します。
  • 生成位置: A1を起点に、上段ヘッダーはB1から、左列ヘッダーはA2から、表本体はB2から作ります。
  • サイズ変更したい場合: B1とA2にヘッダーを事前に並べておくと、その長さで生成されます(例:B1に1~12、A2に1~9で12×9)。

VBA
スポンサーリンク
シェアする
@lifehackerをフォローする
スポンサーリンク
タイトルとURLをコピーしました