[EXCEL]全てのチェックボックスにレ点がなくなったらリスト順を元に戻すよう自動的に並べ変える方法

こちらの質問の続きになります。
https://oshiete.goo.ne.jp/mypage/history/question/

現状こちらのママチャリさんのやり方でやって一度解消しておりましたが、
全てのチェックボックスにレ点がなくなったらリスト順を元に戻すやり方を知りたいです。
ではないと、全てのレ点がなくなったときにリストがそのままばらけたままなので…。
（恐らくGの評価点の隣にH列にリストの上から１、２、３と打ち込んで自動的に反映するよう設定…がよいのですが、その方法がわからずです。）
お手数おかけしますが、ご存知の方いらっしゃいましたらご教授ください。

No.1 ベストアンサー 回答者： ママチャリ 回答日時： 2016/09/11 13:08

Worksheet_Calculateイベントプロシジャをちょっとだけ、変えてみました。

従来の並べ替えキーは、評点（降順）だけでしたが、それにDataName(昇順）を追加しています。
これにより評点が全てゼロの場合、DataName順に並ぶようになります（DataName順が本来の並びと仮定しています）。

話は脱線しますが、今回の質問は質問になっていないような気がします。たぶん、私とWindFallerさん以外には意味が通じないです。広く回答を求めるのであれば、過去の経緯を知らなくても回答できるように質問をまとめるべきです。

Private Sub Worksheet_Calculate()
Application.EnableEvents = False
Me.Sort.SortFields.Clear
Me.Sort.SortFields.Add Key:=Range("G3"), _
SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Me.Sort.SortFields.Add Key:=Range("A3"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Me.Sort
.SetRange Range("A3:G" & Me.Cells.SpecialCells(xlCellTypeLastCell).Row)
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Application.EnableEvents = True
End Sub

No.2 回答者： WindFaller 回答日時： 2016/09/11 14:30

まあ、私は、前回、そのあたりまでは見越していましたが、おそらく書いても、前回の私のコードの延長では、採用するつもりもないようでしたら、この内容は見る必要もないでしょうね。

要するに、チェックボックスをオンになった時に、その前回の順位を残せば済むことです。そしてOffになった時に、その順位を戻せばよいという考え方です。ただ、チェックボックスを取り払った時点で、私のコードではなんともしかねます。

データは、前回のままのものです。

'//
Sub SortMacro()
Dim Rng As Range
Dim NameObj As String
Dim Cntl As Object
Dim stFlg As Long
Dim cbNo As Long
Dim i As Long
Dim sh1 As Worksheet
Set sh1 = ActiveSheet 'シート

On Error Resume Next
NameObj = Application.Caller()
If Err() <> 0 Then MsgBox "このマクロは直接動きません。", vbExclamation: Exit Sub
On Error GoTo 0
Set Cntl = ActiveSheet.CheckBoxes(NameObj)
'二番目の方式
'　cbNo = Mid(NameObj, InStrRev(NameObj, Space(1), , vbTextCompare))
'　cbNo = Val(cbNo) + 1
　cbNo = Cntl.TopLeftCell.Column '物理列
With sh1
'起点
Set Rng = .Range("A3:F11") 'データ範囲
End With
With Rng
　If Cntl.Value = xlOn Then
　For i = 1 To Rng.Rows.Count
　　 sh1.Cells(3, 25 + cbNo).Cells(i, 1).Value = i
　Next i
　　stFlg = 2
　 .Resize(, 25 + cbNo).Sort Key1:=sh1.Cells(3, cbNo), Order1:=stFlg, _
　 Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
　 Orientation:=xlTopToBottom, SortMethod:=xlPinYin
　Else
　 stFlg = 1
　 Rng.Resize(, 25 + cbNo).Sort Key1:=sh1.Cells(3, 26 + cbNo - 1), Order1:=stFlg, _
　 Header:=xlNo, OrderCustom:=1, MatchCase:=False, _
　 Orientation:=xlTopToBottom, SortMethod:=xlPinYin
　End If
End With
End Sub
'//

なお、以下の画像で、ひとつだけトリックがあります。それは、A列の2行目A2 に、0を入れて、非表示(;;;)にしてあります。最初の並び替えに戻すための救護策です。