ExcelVBA(マクロ)で表内の空欄のセルに自動で斜線を引く方法

paper IT

空欄のセルに●●する系マクロで、空いたセルに斜線を引いてみます。

Advertisements

成果物

blankdiago
こんな感じで、実行すると範囲内の空欄がすべて斜線で埋まります。

使い方

diagoblank1
コードを適用できる表は、(改造しない限り)このように長方形のものです。
diagoblank2
開始位置が上から数えて何セル目か、終了位置が左から数えて何セル目かを調べてください。
この場合上から3、左から2番目のセルが開始位置です。
diagoblank3
同様に終了位置の縦、横も調べます。この場合縦が10、横が4です。
diagoblank12
VBEを開いて下記コードをコピペし、赤枠の部分最後の数字にそれぞれ縦位置、横位置、縦の最終位置、横の最終位置を半角数字で入力します。
' vba
Option Explicit
Sub 斜線()
' 空欄の場合
If ActiveCell.Value = "" Then
ActiveCell.Borders(xlDiagonalUp).LineStyle = xlContinuous
' ちがう場合
Else
ActiveCell.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
End If
End Sub
Sub 空欄に斜線()
' 要入力
Dim 縦の位置 As Integer: 縦の位置 = 1
Dim 横の位置 As Integer: 横の位置 = 1
Dim 縦の最終位置 As Integer: 縦の最終位置 = 1
Dim 横の最終位置 As Integer: 横の最終位置 = 1
Dim i As Integer
Dim j As Integer
Dim 横の位置繰り返し用 As Integer: 横の位置繰り返し用 = 横の位置
For i = 縦の位置 To 縦の最終位置
    For j = 横の位置繰り返し用 To 横の最終位置
        Cells(縦の位置, 横の位置繰り返し用).Select
        Call 斜線
        横の位置繰り返し用 = 横の位置繰り返し用 + 1
    Next
    横の位置繰り返し用 = 横の位置
    縦の位置 = 縦の位置 + 1
Next
End Sub

あとはマクロ「空欄に斜線」を実行すればOKです。

ざっくりした解説

diagoblank5
斜線引くコードの下に新しいSubを作ります。
' vba
Dim 縦の位置 As Integer: 縦の位置 = 3
Dim 横の位置 As Integer: 横の位置 = 2
Dim 縦の最終位置 As Integer: 縦の最終位置 = 10
Dim 横の最終位置 As Integer: 横の最終位置 = 4
Dim i As Integer
Dim j As Integer
Dim 横の位置繰り返し用 As Integer: 横の位置繰り返し用 = 横の位置
まずごちゃごちゃ変数を宣言してる部分ですが、動きとして①横の位置から横の最終位置まで移動 → ②縦にひとつ下がる を繰り返すので、横の位置は「初期値」「現在の位置」「最終値」のみっつが必要となります。
繰り返し用が現在の位置にあたります。
For分を二回使っているので、カウンタ変数としてiの他にjを作っています。
' vba
For i = 縦の位置 To 縦の最終位置
    For j = 横の位置繰り返し用 To 横の最終位置
        Cells(縦の位置, 横の位置繰り返し用).Select
        Call macro1
        横の位置繰り返し用 = 横の位置繰り返し用 + 1
    Next
    横の位置繰り返し用 = 横の位置
    縦の位置 = 縦の位置 + 1
Next
For分はこの部分。iのほうのFor分の中で、jのFor分が指定した回数繰り返され、繰り返しが終わるとjの初期値(横の位置繰り返し用)が元に(横の位置に)戻されます。
Call macro1
Call macro1はプロシージャmacro1を呼び出す命令で、
diagoblank10
この状態で実行すると、範囲内に斜線があれば消し、なければ追加するコードになります。
' vba
Option Explicit
Sub 斜線()
' 右上がりの線がある場合
If ActiveCell.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone Then
ActiveCell.Borders(xlDiagonalUp).LineStyle = xlContinuous
' ない場合
Else
ActiveCell.Borders(xlDiagonalUp).LineStyle = xlLineStyleNone
End If
End Sub
Sub 斜線オンオフ()
Dim 縦の位置 As Integer: 縦の位置 = 3
Dim 横の位置 As Integer: 横の位置 = 2
Dim 縦の最終位置 As Integer: 縦の最終位置 = 10
Dim 横の最終位置 As Integer: 横の最終位置 = 4
Dim i As Integer
Dim j As Integer
Dim 横の位置繰り返し用 As Integer: 横の位置繰り返し用 = 横の位置
For i = 縦の位置 To 縦の最終位置
    For j = 横の位置繰り返し用 To 横の最終位置
        Cells(縦の位置, 横の位置繰り返し用).Select
        Call 斜線
        横の位置繰り返し用 = 横の位置繰り返し用 + 1
    Next
    横の位置繰り返し用 = 横の位置
    縦の位置 = 縦の位置 + 1
Next
End Sub
diagoblank11
あとはIf文の条件を変えてやれば、冒頭のコードの出来上がりです。
Excel(エクセル):罫線
罫線の引き方、編集、設定方法まとめです。 Excel操作で罫線 基本の罫線の作り方、引き方、削除方法です。 基本その2、罫線の種類の変更方法です。セルの一部だけに線を引く方法、セルの書式設定で罫線を引く方法につ...
関数・演算子・メソッド・プロパティ名から探すExcel/VBA(マクロ)使い方・組み合わせ方まとめ
こちらはExcelやメソッドの諸機能を、機能の名称から探せるまとめ記事です。

コメント