罫線の有無で範囲選択を行う
Excelで、「Shift」+「Ctrl」を押しながら矢印キーを押せば、データの存在する最終行まで一気に選択することができます。が、下のようなデータの入っていない罫線のみの表で同じことをすると、
こんな感じで、Excelの最終行(1048576行など)まで突き抜けて選択されちゃいます。
通常はデータの有無で下端や右端を判断しますが、今回は罫線の有無で表の下端や右端を判断して一気に範囲選択するマクロを作ってみます。
目次
羅線のある”空白セル”を下端まで選択する
まず、下のように途中に邪魔者がいる直前のセルまで下方向に一気に選択するマクロです。(これは遊びです)
Sub 羅線のある空白セルを下端まで選択する() Dim x As Integer Dim xe As Integer Dim y As Long Dim ye As Long Dim EL As Integer Dim ER As Integer Dim EB As Integer x = Selection.Column '選択中のセルの列番号を取得する y = Selection.Row '選択中のセルの行番号を取得する xe = Selection.Columns(Selection.Columns.Count).Column ye = y EL = Cells(y, x).Borders(xlEdgeLeft).LineStyle 'セルの左端の罫線の種類を取得する ER = Cells(y, x).Borders(xlEdgeRight).LineStyle 'セルの右端の罫線の種類を取得する EB = Cells(y, x).Borders(xlEdgeBottom).LineStyle 'セルの下端の罫線の種類を取得する Do While ((Not EL = xlLineStyleNone Or Not ER = xlLineStyleNone Or Not EB = xlLineStyleNone) _ And Cells(ye, x).Value = "") Or Rows(ye).Hidden = True 'セルの右か左か下に罫線があり、かつ空白の場合は処理を行う。または行が非表示の場合は処理を行う ye = ye + 1 '1行下に進む EL = Cells(ye, x).Borders(xlEdgeLeft).LineStyle ER = Cells(ye, x).Borders(xlEdgeRight).LineStyle EB = Cells(ye, x).Borders(xlEdgeBottom).LineStyle Loop If Not y = ye Then 'ループに一度も入らなかった場合、処理を行わない Range(Cells(y, x), Cells(ye - 1, xe)).Select '選択中のセルから下方向に、罫線があり、かつ空白のセルをすべて選択する End If End Sub
羅線のあるセルを下端まで選択する
次に、邪魔者を無視して、表の下端まで一気に選択するマクロです。
Sub 羅線のあるセルを下端まで選択する() Dim x As Integer Dim xe As Integer Dim y As Long Dim ye As Long Dim EL As Integer Dim ER As Integer Dim EB As Integer x = ActiveCell.Column '選択中のセルの列番号を取得する y = ActiveCell.Row '選択中のセルの行番号を取得する xe = Selection.Columns(Selection.Columns.Count).Column ye = y EL = Cells(y, x).Borders(xlEdgeLeft).LineStyle 'セルの左端の罫線の種類を取得する ER = Cells(y, x).Borders(xlEdgeRight).LineStyle 'セルの右端の罫線の種類を取得する EB = Cells(y, x).Borders(xlEdgeBottom).LineStyle 'セルの下端の罫線の種類を取得する Do While (Not EL = xlLineStyleNone Or Not ER = xlLineStyleNone Or Not EB = xlLineStyleNone) 'セルの右か左か下に罫線がある場合は処理を行う ye = ye + 1 '1行下に進む EL = Cells(ye, x).Borders(xlEdgeLeft).LineStyle ER = Cells(ye, x).Borders(xlEdgeRight).LineStyle EB = Cells(ye, x).Borders(xlEdgeBottom).LineStyle Loop If Not y = ye Then 'ループに一度も入らなかった場合、処理を行わない Range(Cells(y, x), Cells(ye - 1, xe)).Select '選択中のセルから下方向に、罫線があるセルをすべて選択する End If End Sub
羅線のあるセルを右下まで選択する
最後に、表の右下まで一気に選択するマクロです。
Sub 羅線のあるセルを右下まで選択する() Dim X As Integer Dim Y As Long Dim XE As Integer Dim YE As Long Dim EL As Integer Dim ER As Integer Dim EB As Integer X = ActiveCell.Column '選択中のセルの列番号を取得する Y = ActiveCell.Row '選択中のセルの行番号を取得する XE = X YE = Y EL = Cells(Y, X).Borders(xlEdgeLeft).LineStyle 'セルの左端の罫線の種類を取得する ER = Cells(Y, X).Borders(xlEdgeRight).LineStyle 'セルの右端の罫線の種類を取得する EB = Cells(Y, X).Borders(xlEdgeBottom).LineStyle 'セルの下端の罫線の種類を取得する Do While (Not EL = xlLineStyleNone Or Not ER = xlLineStyleNone Or Not EB = xlLineStyleNone) 'セルの右か左か下に罫線がある場合は処理を行う YE = YE + 1 '1行下に進む EL = Cells(YE, X).Borders(xlEdgeLeft).LineStyle ER = Cells(YE, X).Borders(xlEdgeRight).LineStyle EB = Cells(YE, X).Borders(xlEdgeBottom).LineStyle Loop If Not Y = YE Then '下方向のループに一度でも入った場合は処理を行う ER = Cells(YE - 1, X).Borders(xlEdgeRight).LineStyle EB = Cells(YE - 1, X).Borders(xlEdgeBottom).LineStyle End If Do While (Not ER = xlLineStyleNone Or Not EB = xlLineStyleNone) 'セルの右か下に罫線がある場合は処理を行う XE = XE + 1 '1列右に進む ER = Cells(YE - 1, XE).Borders(xlEdgeRight).LineStyle EB = Cells(YE - 1, XE).Borders(xlEdgeBottom).LineStyle Loop If Not Y = YE And Not X = XE Then 'ループに一度も入らなかった場合、処理を行わない Range(Cells(Y, X), Cells(YE - 1, XE - 1)).Select '選択中のセルから右下方向に、罫線があるセルをすべて選択する End If End Sub
※SubからEnd Subまでをコピーし、標準モジュール等に貼り付けて使用して下さい。なお、マクロで実行した処理は「元に戻す」ことができません。実行前に一旦保存しやり直しのできる状態にしておいて下さい。標準モジュールにコードを貼り付けてマクロを使用する方法はこちら。
(2018.8.5 使い勝手向上のためにコードをほんの少し修正)