EXCEL2007のマクロで非表示・並べ替え・塗りつぶし・表示形式の設定がしたい。

シートの1～2行がタイトル行。3行目以降は400人程の個人情報（以後増加有）が1行に1人を言う形でB～BA列まで入力されており、A列にはその個人情報によって関数で通し番号AxxxかTxxx（ｘは数字）が振られるようになっています。

A1は入力規則のリストで【個人データ】【会費】の２択。
A2はマクロ登録用に図形でボタンを作っています。

A1を【個人データ】にした場合はL～AI列を非表示。
A1を【会費】にした場合はAG～AQ列を非表示。
A2をクリックしたらA3以降が通し番号で昇順に並び変え。
その上で
B列に”T”が入力されている行は、すべて塗りつぶしの色を灰色。
B列が”T”以外の行でAJ～AQ列に10000以下の数字が入力されているセルは塗りつぶしが黄色。
B列が”T”以外の行でAJ～AQ列が10000以上の場合は表示形式を【[$-411]ge.m.d;@】にしたいのです。
塗りつぶしや表示形式の設定は「条件付き書式」も考えたのですが、
マクロで並び替えを行うたびに同じルールが複数出来てしまい重くなるので、
マクロで設定できればしたいと思っています。

非表示も並び替えも、A1セルの値に対するchamgeイベント【Private Sub Worksheet_Change(ByVal Target As Range)】で動いていただければA2の図形がいらなくなるのでベストなのですが、
もちろん図形クリックでも構いません。

どうぞよろしくお願いいたします。

No.1 ベストアンサー 回答者： WindFaller 回答日時： 2015/08/25 23:49

こんばんは。

そろそろ、質問を公開してから1週間が経つわけで、気にはしていたので、良く読ませていただきました。
そうすると、いくつかの問題点が見え隠れするのです。
もう少し、自分はここまで作ったけれども、ここが分からないとか、もう少し具体的な形で聞いたほうがよいですね。掲示板は、マクロの作成を依頼するところではありませんから。

1.
>A2をクリックしたらA3以降が通し番号で昇順に並び変え。
項目行がないのでしょうか。

あれば、
>B列が”T”以外の行でAJ～AQ列に10000以下
こちらも使えます。

2.
>B列が”T”以外の行でAJ～AQ列が10000以上の場合は表示形式を【[$-411]ge.m.d;@】にしたいのです。
10000というのは、どうやら日付らしいと分かりましたが、昭和2年で区分けするというのは、かなり変則的です。できれば、数字よりも日付で探したほうが自然のような気がします。今は、純粋に数字を探しています。


A2 の所は、T を入れれば、起動するように変えました。
'//
Private Sub Worksheet_Change(ByVal Target As Range)
　Dim col As Long
　Dim c As Range
　Dim r As Range
　If Target.Count > 1 Then Exit Sub
　If Target.Value = "" Then Exit Sub
　If Target.Address = "$A$1" Then
　　If Target.Value = "個人データ" Then
　　　Columns("L:AQ").EntireColumn.Hidden = False
　　　Columns("L:AI").EntireColumn.Hidden = True
　　ElseIf Target.Value = "会費" Then
　　　Columns("L:AQ").EntireColumn.Hidden = False
　　　Columns("AG:AQ").EntireColumn.Hidden = True
　　ElseIf Target.Value = "OPENSESAME" Then '魔法のことば"(全部オープンにします)
　　　Columns("L:AQ").EntireColumn.Hidden = False
　　End If
　ElseIf Target.Address = "$A$2" Then
　　Application.ScreenUpdating = False
　　If StrConv(Target.Value, vbUpperCase) = "T" Then 'Tが入力されていたら
　　　col = Cells(3, Columns.Count).End(xlToLeft).Column
　　　Range("A3", Cells(Rows.Count, 1).End(xlUp)).Resize(, col).Sort _
　　　Key1:=Range("A3"), Order1:=xlAscending
　　　For Each c In Range("B1", Cells(Rows.Count, 2).End(xlUp))
　　　　If StrConv(c.Value, vbUpperCase) <> "T" Then
　　　　　c.EntireRow.Interior.ColorIndex = xlColorIndexNone
　　　　　Set r = Intersect(c.EntireRow, Columns("AJ:AQ"))
　　　　　Call FindNumbertoYear(r)
　　　　ElseIf StrConv(c.Value, vbUpperCase) = "T" Then
　　　　　c.EntireRow.Interior.ColorIndex = xlColorIndexNone
　　　　　c.EntireRow.Interior.ColorIndex = 15
　　　　End If
　　　Next
　　End If
　　　　Application.ScreenUpdating = True
　End If
End Sub

Sub FindNumbertoYear(ByVal rng As Range)
'サブルーチンマクロ
Dim r As Variant
Dim c As Range
　On Error Resume Next
　Set r = rng.SpecialCells(xlCellTypeConstants, xlNumbers)
　On Error GoTo 0
　If IsObject(r) Then
　For Each c In r.Cells
　　If c.Value2 >= 10000 Then
　　　c.NumberFormatLocal = "[$-411]ge.m.d;@"
　　ElseIf c.Value2 < 10000 Then
　　　c.Interior.ColorIndex = 6
　　End If
　Next c
　End If
End Sub

'///

今回、急遽作りましたので、決定的なミスが残っているかもしれません。