2015年7月10日金曜日

エクセルで選択範囲を1行おきに選択し直すマクロ

エクセルで選択した範囲に対して、1行おきに選択し直すマクロを作成しました。
1行おきに色をつけるなど書式設定に使用したり、不要行の削除に使えます。
コード自体は最下段に記載しています。

■概要
下表に対して、1行ごとに色を塗りたいとしたとき、毎行マウスで選択するのは面倒です。
そこで一度、対象範囲を全体選択して、その範囲で1行おきに選択をし直すマクロです。





(1.元の数表)
(2.全体選択)


(3.1行おき選択(処理結果))

(4.例えばの使い方-選択し直した後に色塗り)

[5.コード]
------------------------------------------------------------
Sub tobitobi()
    '選択範囲を1行おきに選択し直す
    '選択範囲(=Selection)で、左上と右下の行列番号を取得
    '行の位置と幅(列数)を取得
    '最初の行をRangeオブジェクトに格納。
    'Rangeオブジェクトに対して、選択範囲を順次追加(CTRLで選択イメージ-Union関数)
    '(選択セルの移動自体はOFFSET関数)
 
    Dim valran As Range '選択セル移動用
    Dim sel As Range    '選択セル格納用
     
    Dim s_c As Long   '起点行格納
    Dim s_r As Long   '起点列格納
    Dim e_c As Long   '終点行格納
    Dim e_r As Long   '終点列格納
 
    Dim t As Long       '範囲選択用カウンター

 '選択範囲の左上の行列番号取得
    s_r = Selection(1).Row       '起点行取得
    s_c = Selection(1).Column    '起点列取得

 '選択範囲の右下の行列番号取得  終端行
    e_r = Selection(Selection.Count).Row        '終点行取得
    e_c = Selection(Selection.Count).Column     '終点列取得

 '最初の行の登録。オブジェクトの代入なのでSetで格納。
    Set valran = Range(Cells(s_r, s_c), Cells(s_r, e_c))
    Set sel = valran
 
 '各行を登録する。最大値-2しないと、1行多く取得するので注意。
    For t = s_r To e_r - 2 Step 2
        Set sel = Union(sel, sel.Offset(2, 0))
    Next

 '選択範囲を選択
    sel.Select
 
End Sub
------------------------------------------------------------

どうぞ、おためしあれ。

0 件のコメント:

コメントを投稿