今日は、 worksheet_change イベントのプロシージャの中で、並べ替えをするマクロを作ったとき、複数セルを個別に編集したときでも全体の中での並べ替えの回数は1回で済ませる方法。
C列に文字列を入れるとイベントプロシージャが起動。
そのイベントプロシージャの中でC列の値を元にして条件分岐して、B列に値を投入。
そして、B列の入った値を元にして並べ替えをする。
なんていうマクロは、割とよく登場すると思います。
たとえば、1行目がタイトルになっている、以下の表みたいなもの。
|A列 |B列 |C列 | ----------------------------------- 1 行目 |id |num |str | ----------------------------------- 2 行目 |1 |4 |good | ----------------------------------- 3 行目 |2 |5 |excellent | ----------------------------------- 4 行目 |3 |1 |need to improve| ----------------------------------- 5 行目 |4 |2 |average | ----------------------------------- 6 行目 |5 |5 |excellent | ----------------------------------- 7 行目 |6 |4 |good | ----------------------------------- 8 行目 |7 |2 |average | ----------------------------------- 9 行目 |8 |1 |need to improve| ----------------------------------- 10行目 |9 |3 |satisfactory | ----------------------------------- 11行目 |10 |4 |good | -----------------------------------
Private Sub Worksheet_Change(ByVal Target As Range) Dim rg As Range Dim i As Integer For Each rg In Target If rg.Column = 3 Then Select Case rg.Value Case "excellent" i = 5 Case "good" i = 4 Case "satisfactory" i = 3 Case "average" i = 2 Case "need to improve" i = 1 Case Else i = 0 End Select rg.Offset(, -1).Value = i Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlDescending, header:=xlYes End If Next End Sub
ここで、なんらかの事情があって、以下のような、C列にある値を順番に処理していくマクロを書いて実行すると、C列の値が変わる度に並べ替えもされてしまうので、過不足無くすべてのセルに対して処理をすることができなくなる。
Sub setdefalt() Dim c As Long For c = 2 To 11 Range("C" & c).Value = "average" Next End Sub
(※上記のマクロであれば Range(“C2:C11”).Value = “average” と書けばもちろんよいのだが、そんな単純な話でない場合のことを言っています)
ということで、「worksheet_change イベントのプロシージャの中で、並べ替えをするマクロを作ったとき、複数セルを個別に編集したときでも全体の中での並べ替えの回数は1回で済ませる方法はないのか?」という話になる。
で、どうするのかというと。
結論からすると、こういうときは、モジュールレベル変数とローカル変数を組み合わせて、以下のようにやるのが比較的簡単そう。
Dim m As Double, b As Boolean 'Module Level Variable Private Sub Worksheet_Change(ByVal Target As Range) Dim l As Double 'Local Variable Dim rg As Range Dim i As Integer If m = 0 Then m = CDbl(Now) l = m End If For Each rg In Target If rg.Column = 3 Then Select Case rg.Value Case "excellent" i = 5 Case "good" i = 4 Case "satisfactory" i = 3 Case "average" i = 2 Case "need to improve" i = 1 Case Else i = 0 End Select rg.Offset(, -1).Value = i b = True End If Next If m > 0 And l = m And b Then If b Then Range("A1").CurrentRegion.Sort key1:=Range("B1"), order1:=xlDescending, header:=xlYes b = False End If m = 0 End If End Sub
気が向いたらそのうち解説を書きます。