ええ、苦手な作業です。でも、やるです。
相当数の顧客データをどのように整理するか、数ヶ月前から触ってます。並べ替えのレベルの深さでちょっと悩んでいたのですが、なんとかできました。
実現したいのは５段階まで。ＴＡＫＡの手元にある参考書では「最高３つのキーを指定することができます。」（「Excel逆引き大全555の極意」秀和システム、05年５月１日）とのことで、どうしたものかと考えつつ、ボンヤリ自分のExcelで並べ替えをやってました。「あれ、手作業だったら、かなり深いレベルまでできるじゃん」と気付き、「記録マクロ」でスクリプトを残してみたら、はい、大丈夫でした。
「大全555」では、バージョン2003までの対応。ＴＡＫＡが見ていたのはバージョン2007で、その差なのかどうかわからないものの、とりあえずできることに納得。すこし、範囲指定を楽にするため、自動記録したマクロを書き換えました。
きれいなものではありませんが、自分の備忘録用に書き出しておきます。
Sub 並べ替え5段階()
'現在アクティブなシートで、
'データ範囲の右下端セル位置
'を自動取得し、５つのキーで並べ替える
'
'
Const keyLevel As Integer = 5 '並べ替えのレベル指定
Dim j As Integer '繰り返し処理用
Dim cellArea(keyLevel) As String '並べ替え対象セルの範囲指定
'列名指定=上から順にソートレベル＝今回は、FHDAB順。 (0)は使わず
cellArea(1) = "F" '郵便番号
cellArea(2) = "H" '住所2
cellArea(3) = "D" '氏名
cellArea(4) = "A" '番号
cellArea(5) = "B" '日付Dim rowEnd As Integer '資料最後の行番号格納用
rowEnd = ActiveSheet.UsedRange.End(xlDown).Row '底になる行番号取得
Debug.Print rowEnd
Dim rangeArea As String '項目並べ替え対象の範囲格納用
ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
For j = 1 To keyLevel '並び変えのキー列の条件を設定---開始
rangeArea = cellArea(j) & "2:" & cellArea(j) & rowEnd '1行目は見出し＝2行目からがデータの対象
Debug.Print rangeArea
ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Add Key:=Range(rangeArea) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Next j 'For j = 1 To keyLevel '並び変えのキー列の条件を設定---終了Dim columnRight As Integer '項目並べ替え対象の列右端
'A列を1とし、順に数字に置き換えた状態で求められるので、アスキーコードに変換し列名を文字で求める
columnRight = ActiveSheet.UsedRange.End(xlToRight).Column + 64 '64を加えてアスキーコード
Debug.Print columnRight
'並べ替えの実行
With ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort
.SetRange Range("A1:" & Chr(columnRight) & CStr(rowEnd))
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'並び変え条件のクリア
ActiveWorkbook.Worksheets(ActiveSheet.Name).Sort.SortFields.Clear
End Sub
