体験入学でのご質問例① （美術系教職の方から） - 西東京市のパソコン教室パソコンレンタル無料 PC☆LIVE!

展示場の作品の配置表を作りたい。

展示品はいくつかのグループに属しており、点数は未定である。
各グループ名を、縦5行・横は必要数の表に、上から下、左から右へ順に配置して自動で作表したい。

ひばり教室松本：

関数だと式が見にくくなりメンテが悪いのでマクロをつかいました。

Sub OrganizedRepeatText()
Dim i As Long, j As Long, lastRow As Long
Dim targetRow As Long, targetCol As Long, count As Long
Dim columnNumber As Long, totalDataCount As Double
Dim startRow As Long, currentBVal As Variant’ — 初期設定とエラーチェック —
lastRow = Cells(Rows.count, 1).End(xlUp).Row
If lastRow < 1 Then Exit Sub’ B列の合計を確認（エラー回避のため）
totalDataCount = Application.WorksheetFunction.Sum(Range(“B1:B” & lastRow))
If totalDataCount <= 0 Then
MsgBox “B列に有効な数値がありません。”, vbExclamation
Exit Sub
End If’ 処理高速化のため画面更新を停止
Application.ScreenUpdating = False’ — リセット処理 —
‘ G列(7)から右端までの全セルをクリア
Range(Columns(7), Columns(Columns.count)).Clear’ — 変数初期化 —
targetCol = 7 ‘ G列
startRow = 1 ‘ ヘッダー行の開始位置
targetRow = 2 ‘ データの開始位置
columnNumber = 1 ‘ ヘッダーの連番
count = 0 ‘ 累計データ数’ 最初のヘッダー作成
Call ApplyHeaderStyle(Cells(startRow, targetCol), columnNumber)’ — メイン処理ループ —
For i = 1 To lastRow
currentBVal = Cells(i, 2).Value’ B列が正の数値の場合のみ処理
If IsNumeric(currentBVal) And currentBVal > 0 ThenFor j = 1 To Int(currentBVal)
‘ 1. データの記入と中央揃え
With Cells(targetRow, targetCol)
.Value = Cells(i, 1).Value
.HorizontalAlignment = xlCenter
End Withcount = count + 1
targetRow = targetRow + 1’ 全データ記入済みなら終了
If count >= totalDataCount Then GoTo Finish

‘ 2. 5行（1列分）書き終えたら次の列へ
If count Mod 5 = 0 Then
columnNumber = columnNumber + 1

‘ P列(16)まで到達したか判定
If targetCol >= 16 Then
targetCol = 7 ‘ G列に戻る
‘ 開始行の移動（G1→G8→G16の規則：1回目は+7、2回目以降は+8）
If startRow = 1 Then
startRow = startRow + 7 ‘ 次は8行目
Else
startRow = startRow + 8 ‘ 以降は8行ずつ加算
End If
Else
targetCol = targetCol + 1
End If

targetRow = startRow + 1
Call ApplyHeaderStyle(Cells(startRow, targetCol), columnNumber)
End If
Next j

End If
Next i

Finish:
‘ — 仕上げ —
‘ G列からP列までの幅を自動調整
On Error Resume Next: Columns(“G:P”).AutoFit: On Error GoTo 0
‘ 画面更新を再開
Application.ScreenUpdating = True

MsgBox “完了しました！”, vbInformation
End Sub

‘ ヘッダー専用の書式設定
Private Sub ApplyHeaderStyle(rng As Range, num As Long)
With rng
.Value = num
.HorizontalAlignment = xlCenter
.Interior.Color = RGB(220, 235, 255) ‘ 薄い青
.Font.Bold = True
‘ 枠線を付ける場合は以下を追加
.Borders.Weight = xlThin
End With
End Sub