以下のマクロは、シート上の状態に応じて完全自動で掛け算表を作ります。ヘッダー(上段と左列)が既にあればそれを読み取り、無ければ自動で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)。

