Excel VBA 54 Excelで選択したセルに罫線を自動設定

よく使う「選択したセルに罫線設定」をショートカットで処理したいので作成しました。

基本構文は・・・

With Selection.Borders(位置)

.LineStyle = xlContinuous ' 実線

.Weight = xlThin ' 太さ（細線）

.Color = RGB(0, 0, 0) ' 色（黒）

End With

太さ指定は・・・

xlHairline … 極細

xlThin … 細

xlMedium … 中

xlThick … 太

Sub 外枠だけ太線()

With Selection.Borders(xlEdgeLeft)

.LineStyle = xlContinuous

.Weight = xlThick

End With

With Selection.Borders(xlEdgeTop)

.LineStyle = xlContinuous

.Weight = xlThick

End With

With Selection.Borders(xlEdgeRight)

.LineStyle = xlContinuous

.Weight = xlThick

End With

With Selection.Borders(xlEdgeBottom)

.LineStyle = xlContinuous

.Weight = xlThick

End With

End Sub

処理結果

Sub 外枠太線_内側細線()

' 外枠 太線

Selection.Borders(xlEdgeLeft).LineStyle = xlContinuous

Selection.Borders(xlEdgeLeft).Weight = xlThick

Selection.Borders(xlEdgeTop).LineStyle = xlContinuous

Selection.Borders(xlEdgeTop).Weight = xlThick

Selection.Borders(xlEdgeRight).LineStyle = xlContinuous

Selection.Borders(xlEdgeRight).Weight = xlThick

Selection.Borders(xlEdgeBottom).LineStyle = xlContinuous

Selection.Borders(xlEdgeBottom).Weight = xlThick

' 内側 細線

Selection.Borders(xlInsideVertical).LineStyle = xlContinuous

Selection.Borders(xlInsideVertical).Weight = xlThin

Selection.Borders(xlInsideHorizontal).LineStyle = xlContinuous

Selection.Borders(xlInsideHorizontal).Weight = xlThin

End Sub

処理結果

Sub 全体に中線()

With Selection.Borders

.LineStyle = xlContinuous

.Weight = xlMedium

.Color = RGB(0, 0, 0)

End With

End Sub

処理結果

Excel VBA 53 Excelで作業中シートのセル幅を自動調整

Excelで作業中シートのセル幅を自動調整せせます。

今回は編集画面への移動を開発メニューからではなくワークシート名から行ってみます。マクロ一覧を呼び出したり、ショートカットで処理するわけではないので開発メニューを表示していなくても問題ないです。

まず、シートタグを右クリックして表示されるメニューから［コードの表示］を選び、ソースを入力します。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim col As Range

Application.EnableEvents = False ' 無限ループ防止

On Error Resume Next

For Each col In Target.Columns

col.EntireColumn.AutoFit

Next col

On Error GoTo 0

Application.EnableEvents = True

End Sub

入力すると［General］が［Worksheet］へ自動的に変更されます。

後は黙々とデーターを入力するだけです。

コピー&ペーストでも連動します。

さすがに大量の入力はテキストエディターでtabを挟んで入力した方が速いですが、追加データに入力のときには重宝します。

Excel VBA 52 Excelで選択したセルの罫線を自動生成

選択したセルの罫線（格子+太い外枠）と1行目のセルの塗りつぶしを自動生成します。

Sub SetGridWithBoldBorderAndFill()

Dim rng As Range

Dim border As Variant

Dim firstRow As Range

Dim colorDialog As Object

Dim chosenColor As Long

' 選択範囲を取得

Set rng = Selection

' 格子状の罫線を設定

rng.Borders(xlInsideHorizontal).LineStyle = xlContinuous

rng.Borders(xlInsideHorizontal).Weight = xlThin

rng.Borders(xlInsideVertical).LineStyle = xlContinuous

rng.Borders(xlInsideVertical).Weight = xlThin

' 外枠を太枠に設定

For Each border In Array(xlEdgeLeft, xlEdgeRight, _

xlEdgeTop, xlEdgeBottom)

With rng.Borders(border)

.LineStyle = xlContinuous

.Weight = xlThick

End With

Next border

' 最初の行を取得

Set firstRow = rng.Rows(1)

' カラーダイアログを表示し、ユーザーに色を選択させる

Set colorDialog = Application.Dialogs(xlDialogEditColor)

If colorDialog.Show(1) Then

chosenColor = ActiveWorkbook.Colors(1)

firstRow.Interior.Color = chosenColor

End If

End Sub

データの有無に関係なく・・・

任意のセルを選択して実行すると・・・

選択した範囲の一行目の塗りつぶしの色を要求してくるので設定すれば・・・

全体は格子、太線の外枠で選択した範囲の一行目の塗りつぶしが完了します。

Excel VBA 51 単純処理でもデータ量が多い場合もVBA

単純でも大量処理の場合はVBAで対処した方が賢明です。

データの全体です。

データはA1:L31まで入力されていて

C2:L31までの30名の10科目のテスト結果です。

作成するデータは・・・

M列に合計点

N列に平均点

O列に合否

85点以上はA合格、75点以上はB合格、65点以上はB合格。それ以外は不合格。

を入力する簡単な計算です。サンプルは30名分ですが、もし1000名文分と言った場合はフィルよりも今回のVBAを￥のセル指定を変更して活用すれば一気に処理出来ます。

Sub 計算式を入力し右揃え()

Dim ws As Worksheet

Dim i As Integer

' アクティブシートを設定（または特定のシートを指定）

Set ws = ActiveSheet

' 2行目から31行目まで繰り返し処理

For i = 2 To 31

' M列（合計）

ws.Cells(i, 13).Formula = _

"=SUM(C" & i & ":L" & i & ")"

ws.Cells(i, 13).HorizontalAlignment = xlRight ' 右揃え

' N列（平均）

ws.Cells(i, 14).Formula = _

"=AVERAGE(C" & i & ":L" & i & ")"

ws.Cells(i, 14).HorizontalAlignment = xlRight ' 右揃え

' O列（評価）

ws.Cells(i, 15).Formula = "=IF(N" & i _

& ">=85,""A合格"",IF(N" & i & ">=75,""B合格"",IF(N" & i _

& ">=65,""C合格"",""不合格"")))"

ws.Cells(i, 15).HorizontalAlignment = xlRight ' 右揃え

Next i

' メッセージ表示（オプション）

MsgBox "数式を31行目まで入力し、右揃えにしました！", _

vbInformation

End Sub

というコトで上は処理結果です。

Excel VBA 50 Exccelで指定月のカレンダーを作成

Exccelで指定した年月のカレンダーを作成します。

Sub CreateCalendarFromUserInput()

Dim ws As Worksheet

Dim yearInput As Integer, monthInput As Integer

Dim startDate As Date, endDate As Date

Dim row As Integer, col As Integer, dayCounter As Integer

' シートを取得（カレンダーシートを作成・クリア）

Set ws = ThisWorkbook.Sheets("Sheet1")

' 必要に応じてシート名を変更

ws.Cells.Clear ' 既存のカレンダーをクリア

' ユーザーに年と月を入力してもらう

yearInput = InputBox("西暦を入力してください（例：2025）", _

"年の入力")

If yearInput < 1900 Or yearInput > 2100 Then

MsgBox "有効な年（1900?2100）を入力してください。", _

vbExclamation

Exit Sub

End If

monthInput = InputBox("月を入力してください（1?12）", _

"月の入力")

If monthInput < 1 Or monthInput > 12 Then

MsgBox "有効な月（1?12）を入力してください。", _

vbExclamation

Exit Sub

End If

' 開始日と終了日を設定

startDate = DateSerial(yearInput, monthInput, 1)

endDate = DateSerial(yearInput, monthInput + 1, 0)

' ヘッダーにタイトル

ws.Cells(1, 1).Value = yearInput & "年 " & monthInput & "月"

ws.Cells(1, 1).Font.Size = 14

ws.Cells(1, 1).Font.Bold = True

ws.Range("A1:G1").Merge

ws.Cells(1, 1).HorizontalAlignment = xlCenter

' 曜日ヘッダー

Dim daysOfWeek As Variant

daysOfWeek = Array("日", "月", "火", "水", "木", "金", "土")

' 曜日を2行目に設定

For col = 0 To 6

ws.Cells(2, col + 1).Value = daysOfWeek(col)

ws.Cells(2, col + 1).Font.Bold = True

ws.Cells(2, col + 1).HorizontalAlignment = xlCenter

ws.Cells(2, col + 1).Interior.Color = RGB(200, 200, 250)

' ヘッダーの背景色

Next col

' 日付を埋める

row = 3

col = weekDay(startDate, vbSunday) - 1

' 週の最初の曜日（0:日曜, 6:土曜）

For dayCounter = 1 To Day(endDate)

ws.Cells(row, col + 1).Value = dayCounter

ws.Cells(row, col + 1).HorizontalAlignment = xlCenter

col = col + 1

If col > 6 Then

col = 0

row = row + 1

End If

Next dayCounter

' セルのサイズ調整

ws.Cells.EntireColumn.AutoFit

ws.Range("A2:G2").Interior.Color = RGB(200, 200, 250)

' ヘッダー色

ws.Range("A3:G" & row).Borders.LineStyle = xlContinuous

' 罫線

MsgBox "カレンダーが作成されました！", vbInformation

End Sub

実行したら年月を入力すれば・・・

A2〜G8を利用してカレンダーを表示します。

Excel VBA 49 ExccelでA1とA2セルの色を指定段階の色相グラデに

ExcelでA1とA2セルの色から指定した段階の色相グラデ—ションを作成します。

Sub ApplyHueGradientToColumnB()

Dim ws As Worksheet

Dim startColor As Long, endColor As Long

Dim steps As Integer, i As Integer

Dim startHue As Single, endHue As Single

Dim startSaturation As Single, startBrightness As Single

Dim endSaturation As Single, endBrightness As Single

Dim h As Single, s As Single, b As Single

Set ws = ActiveSheet

startColor = ws.Range("A1").Interior.Color

endColor = ws.Range("A2").Interior.Color

steps = Application._

        InputBox("ステップ数を入力してください:", Type:=1)

' RGBからHSBに変換

RGBtoHSB startColor, startHue, startSaturation, startBrightness

RGBtoHSB endColor, endHue, endSaturation, endBrightness

' グラデーションを適用

For i = 0 To steps

h = startHue + (endHue - startHue) * i / steps

s = startSaturation + _

            (endSaturation - startSaturation) * i / steps

b = startBrightness + _

            (endBrightness - startBrightness) * i / steps

ws.Cells(i + 3, 2).Interior.Color = HSBtoRGB(h, s, b) ' B列に適用

Next i

End Sub

' RGB を HSB に変換

Sub RGBtoHSB(ByVal rgbColor As Long, _

    ByRef h As Single, ByRef s As Single, ByRef b As Single)

Dim r As Single, g As Single, bl As Single

Dim minVal As Single, maxVal As Single, delta As Single

r = (rgbColor Mod 256) / 255

g = ((rgbColor ¥ 256) Mod 256) / 255

bl = (rgbColor ¥ 65536) / 255

minVal = WorksheetFunction.Min(r, g, bl)

maxVal = WorksheetFunction.Max(r, g, bl)

delta = maxVal - minVal

b = maxVal ' 明度

If delta = 0 Then

h = 0

s = 0

Else

s = delta / maxVal ' 彩度

If maxVal = r Then

h = (g - bl) / delta

ElseIf maxVal = g Then

h = 2 + (bl - r) / delta

Else

h = 4 + (r - g) / delta

End If

h = h * 60

If h < 0 Then h = h + 360

End If

End Sub

' HSB を RGB に変換

Function HSBtoRGB(ByVal h As Single, _

    ByVal s As Single, ByVal b As Single) As Long

Dim r As Single, g As Single, bl As Single

Dim i As Integer, f As Single, p As Single, q As Single, t As Single

If s = 0 Then

r = b: g = b: bl = b

Else

h = h / 60

i = Int(h)

f = h - i

p = b * (1 - s)

q = b * (1 - s * f)

t = b * (1 - s * (1 - f))

Select Case i Mod 6

Case 0: r = b: g = t: bl = p

Case 1: r = q: g = b: bl = p

Case 2: r = p: g = b: bl = t

Case 3: r = p: g = q: bl = b

Case 4: r = t: g = p: bl = b

Case 5: r = b: g = p: bl = q

End Select

End If

HSBtoRGB = RGB(Int(r * 255), Int(g * 255), Int(bl * 255))

End Function

A1とA2セルに基準となる塗りを行い、VBAを実行すると段階数を入力するパレットが表示されるので任意入力すれば・・・

指定段階段階の基準の色の間となる段階の塗りをB列に表示します。

Excel VBA 48 Excelで選択したエリアを市松模様選択

Excelで選択したエリアを一行おきに選択し、色を設定します。

デフォルト環境で設定するのが面倒くさいので作成した一行版の市松模様版です。

Excel VBA 47　Excelで選択したエリアを一列おきに選択 2025/07/16

Excel VBA 46　Excelで選択したエリアを一行おきに選択 2025/06/25

Sub SelectCheckerboardPattern()

Dim rng As Range

Dim cell As Range

Dim newSelection As Range

Dim rowIndex As Integer, colIndex As Integer

' 選択範囲を取得

On Error Resume Next

Set rng = Selection

On Error GoTo 0

' 範囲が選択されていない場合、エラーを表示

If rng Is Nothing Then

MsgBox "セル範囲を選択してください。", _

vbExclamation, "エラー"

Exit Sub

End If

' 市松模様（チェッカーパターン）に選択

For rowIndex = 1 To rng.Rows.Count

For colIndex = 1 To rng.Columns.Count

If (rowIndex + colIndex) Mod 2 = 0 Then

Set cell = rng.Cells(rowIndex, colIndex)

If newSelection Is Nothing Then

Set newSelection = cell

Else

Set newSelection = Union(newSelection, cell)

End If

End If

Next colIndex

Next rowIndex

' 選択を適用

If Not newSelection Is Nothing Then

newSelection.Select

End If

MsgBox "市松模様（チェッカーパターン）で選択しました！", _

vbInformation, "完了"

End Sub

エリアを選択し・・・

実行すると市松模様的に選択した状態になるので・・・

カラーパレットで任意の色を設定。

シンプルな動きの方が応用が利きますね。

Excel VBA 47 Excelで選択したエリアを一列おきに選択

Excelで選択したエリアを一行おきに選択し、色を設定します。

デフォルト環境で設定するのが面倒くさいので作成した一行版の一列版です。

Sub SelectAlternateColumnsWithinSelection()

Dim rng As Range

Dim colRange As Range

Dim newSelection As Range

Dim colIndex As Integer

' 選択範囲を取得

On Error Resume Next

Set rng = Selection

On Error GoTo 0

' 範囲が選択されていない場合、エラーを表示

If rng Is Nothing Then

MsgBox "セル範囲を選択してください。", _

vbExclamation, "エラー"

Exit Sub

End If

' 選択範囲の1列おきの列を取得

For colIndex = 1 To rng.Columns.Count Step 2

Set colRange = rng.Columns(colIndex)

If newSelection Is Nothing Then

Set newSelection = colRange

Else

Set newSelection = Union(newSelection, colRange)

End If

Next colIndex

' 選択を適用

If Not newSelection Is Nothing Then

newSelection.Select

End If

MsgBox "選択範囲内の1列おきの列を選択しました！", _

vbInformation, "完了"

End Sub

エリアを選択し・・・

実行すると1列おきに選択した状態になるので・・・

カラーパレットで任意の色を設定。

シンプルな動きの方が応用が利きますね。

Excel VBA 46 Excelで選択したエリアを一行おきに選択

Excelで選択したエリアを一行おきに選択し、色を設定します。

デフォルト環境で設定するのが面倒くさいので作成して見ました。

Sub SelectAlternateRowsWithinSelection()

Dim rng As Range

Dim rowRange As Range

Dim newSelection As Range

Dim rowIndex As Integer

' 選択範囲を取得

On Error Resume Next

Set rng = Selection

On Error GoTo 0

' 範囲が選択されていない場合、エラーを表示

If rng Is Nothing Then

MsgBox "セル範囲を選択してください。", _

vbExclamation, "エラー"

Exit Sub

End If

' 選択範囲の1行おきの行を取得

For rowIndex = 1 To rng.Rows.Count Step 2

Set rowRange = rng.Rows(rowIndex)

If newSelection Is Nothing Then

Set newSelection = rowRange

Else

Set newSelection = _

Union(newSelection, rowRange)

End If

Next rowIndex

' 選択を適用

If Not newSelection Is Nothing Then

newSelection.Select

End If

MsgBox "選択範囲内の1行おきの行を選択しました！", _

vbInformation, "完了"

End Sub

エリアを選択し・・・

実行すると1行おきに選択した状態になるので・・・

カラーパレットで任意の色を設定。

シンプルな動きの方が応用が利きますね。