飛び飛びになった表の並び替え＆特定の列の背景色を変更

Question

添付画像のように
表に対して、
①順位を基準に昇順に並び替え
②表内で特定の列の背景色を変更
　（例えば…a支店、佐藤、東京、埼玉、千葉、福岡を含む列の背景色を赤色に変更）
となるようなVBAを作りたいのですが、バラバラの表をうまく選択して処理していく方法が思いつきません。（表もA列から始まるとは限らない。）
どのような記述法が考えられるでしょうか？

yokomaya · Accepted Answer

Sub test()
Dim rg As Range, ur As Range, fc As Range
Set ur = UsedRange
Set rg = ur.Find("順位", ur.Item(ur.Count))
Set fc = rg
Do While Not rg Is Nothing
    MsgBox Range(rg, rg.End(xlToRight).End(xlDown)).Address
    Set rg = ur.FindNext(rg)
    If rg.Address = fc.Address Then Exit Do
Loop
End Sub

これで領域化があっているなら
このmsgboxで使った領域を用いて
SUB を呼び出して加工すれば如何でしょうか？

tom04 · Answer

No.8です。

＞シートには結合セルがつかわれていて結合を解除しないとエラーが出ました。

行の途中で結合セルがあると「並び替え」の時にエラーになるはずです。
そのため前回のコードは画像のA1～C4セルのように
最終行だけ結合があっても対応できるコードにしていました。

結合セルを解除してマクロを実行されたというコトですので、
少しコードに手を加えました。（★の行だけです）

Sub Sample2()
Dim myStr As String, c As Range
Dim myS As Long, endRow As Long, endCol As Long
Dim myFound As Range, myFirst As Range
Dim myRng As Range, myArea As Range

myStr = "a支店、佐藤、東京、埼玉、千葉、福岡"
Set myFound = Cells.Find(what:="順位", LookIn:=xlValues, lookat:=xlWhole)
If Not myFound Is Nothing Then '//←念のため//
Set myFirst = myFound
GoTo 処理
Do
Set myFound = Cells.FindNext(after:=myFound)
If myFound.Address = myFirst.Address Then Exit Do
GoTo 処理
処理:
Set myRng = myFound.CurrentRegion
myS = myFound.Row + 1
endRow = myRng(myRng.Count).Row
If Cells(endRow, myFound.Column).MergeCells Then
endRow = endRow - 1
End If
endCol = myRng(myRng.Count).Column
Set myArea = Range(Cells(myS, myFound.Column), Cells(endRow, endCol))
myArea.Sort key1:=myArea(1), order1:=xlAscending, Header:=xlNo
For Each c In myArea
If c <> "" And InStr(myStr, c) > 0 Then '//←少し条件を追加★//
Range(Cells(c.Row, myFound.Column), Cells(c.Row, endCol)).Interior.ColorIndex = 3
End If
Next c
Loop
End If
End Sub

上記のマクロを実行すると
画像のように左側の表が右側の表のようになりました。

こちらではお望みの動きになったと思ったのですが、
お手元の表の具体的なレイアウトが判らないので
まずはこの程度で・・・m(_ _)m

tom04 · Answer

こんばんは！

一例です。
各表は隣接していない！という前提です。
（表と表の間は必ず1列・1行以上離れている）

Sub Sample1()
    Dim myEnd As Long, myStr As String, c As Range
    Dim myS As Long, endRow As Long, endCol As Long
    Dim myFound As Range, myFirst As Range
    Dim myRng As Range, myArea As Range

myStr = "a支店、佐藤、東京、埼玉、千葉、福岡"
        Set myFound = Cells.Find(what:="順位", LookIn:=xlValues, lookat:=xlWhole)
            If Not myFound Is Nothing Then  '//←念のため//
            Set myFirst = myFound
            GoTo 処理
            Do
                Set myFound = Cells.FindNext(after:=myFound)
                If myFound.Address = myFirst.Address Then Exit Do
                GoTo 処理
処理:
             Set myRng = myFound.CurrentRegion
             myS = myFound.Row + 1
             endRow = myRng(myRng.Count).Row
                If Cells(endRow, myFound.Column).MergeCells Then
                    endRow = endRow - 1
                End If
             endCol = myRng(myRng.Count).Column
             Set myArea = Range(Cells(myS, myFound.Column), Cells(endRow, endCol))
             myArea.Sort key1:=myArea(1), order1:=xlAscending, Header:=xlNo
                For Each c In myArea
                    If InStr(myStr, c) > 0 Then
                        Range(Cells(c.Row, myFound.Column), Cells(c.Row, endCol)).Interior.ColorIndex = 3
                    End If
                Next c
        Loop
        End If
End Sub

こんな感じではどうでしょうか？m(_ _)m

yokomaya · Answer

条件付き書式だけといったが
条件付き書式が案外ややこしかったので
追記しておきます。

まずa支店、佐藤、東京、埼玉、千葉、福岡の
候補をどこかのシートで縦に並べて
名前定義しておきます。（仮に今回は着目って名前にしました）
（候補数が変動するなら名前定義　可変領域で検索して
追随する式に変更してください）

それが表の２列目にあるものという前提で
表が仮にE1:H10の場合
そこを選択して条件付き書式で

数式を使用して書式設定するセルを決定を選び

=MATCH(OFFSET(A1,0,6-COLUMN(A1)),着目,0)

書式は塗りつぶしの赤です。
途中の６が表の始まり列＋１の数字になります。

VBAではマクロの記録で上記操作をして
そこを選択してというのはSELECT不要なので
Selection　の所にSubへの引数である
msgboxが指していた領域を用います。
次に数式の６の部分のみ領域のRange変数名に続けて
.Columns(2).column
とすればA列からの時は２、E列の時は６になります。

tatsu99 · Answer

＞表もA列から始まるとは限らない。・・・とのことですが、
本件、表の位置を決めてしまうのが、本来の解決法かと思いますが、
表の列を決められない理由は何でしょうか。
その理由、背景等が判れば、別の解決法が見つかるかもしれません。

yokomaya · Answer

＞選択範囲を拡張して昇順ソート
拡張は要らないですね。
領域は指定済だから。

基本選択（Select)もほとんど要らないです。
手で操作すると選択しなきゃ勿論操作できないけど
マクロの記録はSelectionにその時の選択セルを
書けば成り立つ場合が多いです。
その場合直前のSELECTが無用ということで。

yuji3690 · Answer

あ、失礼しました。右上の表以外変わってない気がしたもので、N2~8の例のみ出しましたが、どちみち範囲が列全体になっているので失敗ですね。
N2~8であれば=SMALL(E$2:E$8,ROW()-ROW(N$1))とするべきでした。
左下の表も変わっているし、左上・右下の表はたまたま変わっていないだけで、順位どおりに並べているわけですね。
E$2:E$8とN$1をそれぞれ該当する範囲・タイトル行にすれば対応できます。
『順位』と表示されているセルを基準として考えると分かり易いかと。

yuji3690 · Answer

VBAの式は分からないので、関数によって別のセルに表示させる場合を説明します。
関数でできることは同様にしてVBAでできるのだろうと思いますので、考え方の参考まで。

並び替え
同順位があるようですので、作業列を用いてIDを割り振ります。
ID=順位&"-"&その順位がそのセルで何回目か（同着が無い場合は必ず-1、同着があれば上から順に-1,-2…）
N2～8はSMALL(E:E,ROW()-1)とすることで、その行に表示する順位を算出させます。
作業列を用いてIDに変換します。検索用のIDの計算については、先ほどのIDと同様です。
MATCHを使って検索用のIDと一致するIDの行番号を取得します。
INDIRECTと取得したいデータの列名、取得した行番号、を用いて、検索用IDと一致する行の県・件数・合計を表示します。

これによって並び替えは完了です。

セルに色をつけるのは条件付書式で可能かと思われます。

yokomaya · Answer

（表もA列から始まるとは限らない。）
この時点で、じゃあどうやって見つけるのかを書かずに
プログラムに出来ると考えてはるんでしょうか？

プログラムは指示した通りのことはやりますが
指示もしないことを自発的にしたりしません。

しかも、内容はソートと条件付き書式だけなので
マクロ記録できるし、後はその領域の決め方を
コードにするだけです。

その肝心の領域の決め方を記述せずに
どうすることもできません。

飛び飛びになった表の並び替え＆特定の列の背景色を変更

Sub test()

No.8です。

こんばんは！

条件付き書式だけといったが

＞表もA列から始まるとは限らない。

＞選択範囲を拡張して昇順ソート

あ、失礼しました。

VBAの式は分からないので、関数によって別のセルに表示させる場合を説明します。

（表もA列から始まるとは限らない。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング