VBAの勉強を始めてみた

色々試しています。

罫線の有無で範囲選択を行う

Excelで、「Shift」+「Ctrl」を押しながら矢印キーを押せば、データの存在する最終行まで一気に選択することができます。が、下のようなデータの入っていない罫線のみの表で同じことをすると、

f:id:kouten0430:20180317134649j:plain

 

こんな感じで、Excelの最終行(1048576行など)まで突き抜けて選択されちゃいます。

f:id:kouten0430:20180317134704j:plain


通常はデータの有無で下端や右端を判断しますが、今回は罫線の有無で表の下端や右端を判断して一気に範囲選択するマクロを作ってみます。

目次

 

 

羅線のある”空白セル”を下端まで選択する 

まず、下のように途中に邪魔者がいる直前のセルまで下方向に一気に選択するマクロです。(これは遊びです)

f:id:kouten0430:20180317134826j:plain

 

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

 

 

羅線のあるセルを下端まで選択する

次に、邪魔者を無視して、表の下端まで一気に選択するマクロです。

f:id:kouten0430:20180317135018j:plain

 

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

 

 

羅線のあるセルを右下まで選択する

最後に、表の右下まで一気に選択するマクロです。

f:id:kouten0430:20180317135145j:plain

 

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 使い勝手向上のためにコードをほんの少し修正)