今日は、 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
気が向いたらそのうち解説を書きます。