【VBA】表をソートする(Range.Sortメソッドを使用)
<機能>
Range.Sortメソッドを使用して指定列で表をソートします
(1)アクティブシートにテスト用の表「日本百名山」を作成
(2)B列の「標高」で表をソートします
<動作検証&開発環境>
Microsoft Office 2016
<使い方>
適当なところにソースを張り付けてください
VBAで表をソートする() を実行するとソート処理を開始します
<実行イメージ>
ソート前とソート後のイメージです
'********************************************
'VBAでリスト(表)をソートする
'(1)アクティブシートにテスト用の表(日本百名山)を作成
'(2)標高の降順でソート(高い順でソート)
'********************************************
Sub VBAで表をソートする()
'//テストデータ「日本百名山」表を作成
SetTestData
'//標高でソートする
'//項目行を除くため2行目移行をソートする
'//Key1 : 最初の並べ替えフィールド(B列の標高で並べ替え)
'//order1: Key1で指定した値の並べ替え順序(昇順:xlAscending 降順:xlDescending)
'//Header: 最初の行にヘッダ情報が含まれているか(ヘッダを判断:xlGuess 含まれない(規定値):xlNo 含まれる:xlYes)
Columns("A:B").Sort _
Key1:=Range("B2"), _
order1:=xlDescending, _
Header:=xlYes
Range("A1").Select
End Sub
'********************************************
'アクティブシートに「日本百名山」表を作成する
'********************************************
Sub SetTestData()
Dim ar As Variant
ar = Array("百名山,標高(m)", "利尻岳,1721", "羅臼岳,1660", "斜里岳,1545", "阿寒岳,1499", "大雪山,2290", _
"トムラウシ,2141", "十勝岳,2077", "幌尻岳,2052", "後方羊蹄山,1898", "岩木山,1625", _
"八甲田山,1584", "八幡平,1613", "岩手山,2038", "早池峰山,1917", "鳥海山,2236", _
"月山,1984", "朝日岳,1870", "蔵王山,1841", "飯豊山,2128", "吾妻山,2035", _
"安達太良山,1709", "磐梯山,1819", "会津駒ヶ岳,2133", "那須岳,1917", "燧ヶ岳,2356", _
"至仏山,2228", "武尊山,2158", "男体山,2484", "奥白根山,2578", "皇海山,2144", _
"赤城山,1828", "筑波山,877", "両神山,1723", "雲取山,2017", "甲武信岳,2475", _
"金峰山,2599", "瑞牆山,2230", "大菩薩嶺,2057", "丹沢山,1673", "富士山,3776", _
"天城山,1406", "谷川岳,1977", "草津白根山,2578", "四阿山,2354", "浅間山,2568", _
"越後駒ヶ岳,2003", "平ヶ岳,2141", "巻機山,1967", "雨飾山,1963", "苗場山,2145", _
"妙高山,2454", "火打山,2462", "高妻山,2353", "白馬岳,2932", "五竜岳,2814", _
"鹿島槍ヶ岳,2889", "剱岳,2998", "立山,3015", "薬師岳,2926", "黒部五郎岳,2840", _
"水晶岳,2986", "鷲羽岳,2924", "槍ヶ岳,3180", "穂高岳,3190", "常念岳,2857", _
"笠ヶ岳,2897", "焼岳,2455", "乗鞍岳,3026", "御嶽山,3067", "美ヶ原,2034", _
"霧ヶ峰,1925", "蓼科山,2530", "八ヶ岳,2899", "木曽駒ヶ岳,2956", "空木岳,2864", _
"恵那山,2191", "甲斐駒ヶ岳,2967", "仙丈ヶ岳,3033", "鳳凰山,2840", "北岳,3192", _
"間ノ岳,3189", "塩見岳,3052", "悪沢岳,3141", "赤石岳,3120", "聖岳,3013", _
"光岳,2591", "白山,2702", "荒島岳,1523", "伊吹山,1377", "大台ヶ原山,1695", _
"大峰山,1915", "大山,1729", "剣山,1955", "石鎚山,1982", "九重山,1791", _
"祖母山,1756", "阿蘇山,1592", "霧島山,1700", "開聞岳,924", "宮之浦岳,1936")
ThisWorkbook.Activate
Cells.Select
Selection.Clear
Selection.ColumnWidth = 15
Selection.RowHeight = 30
Selection.Font.Name = "MS ゴシック"
Selection.Font.Size = 10
'//折り返して全体を表示する
Selection.WrapText = True
Range("A1").Select
'//データをシートに展開
Dim i As Integer, j As Integer
Dim wkbuf As Variant
For i = 0 To UBound(ar)
wkbuf = Split(ar(i), ",")
'不正なデータであれば次レコードへ
If UBound(wkbuf) <> 1 Then GoTo nextrec
'データを表示
For j = 0 To UBound(wkbuf)
Cells(i + 1, j + 1) = wkbuf(j)
Next j
nextrec:
Next i
'//罫線を引く
With Range("A1:B" & CStr(UBound(ar) + 1)).Borders
.LineStyle = xlContinuous
.Weight = xlMedium
End With
'//項目行の背景色をセット
With Range("A1:B1")
.Interior.Color = RGB(0, 255, 130)
.HorizontalAlignment = xlHAlignCenter
.VerticalAlignment = xlVAlignCenter
End With
End Sub
よろしければポチッと押してください