Sub mondai9()
Columns("B:B").Select
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
.SetRange Range("A2:B317")
.Orientation = xlTopToBottom
.Apply
End With
Dim BG As Long
Dim BEG As Long
Dim WSM As Worksheet
Dim ToG As Long
Set WSM = Worksheets("main")
BEG = WSM.Range("B65536").End(xlUp).Row
ToG = 2
For BG = 2 To BEG
If WSM.Range("B" & BG).Value <> WSM.Range("B" & BG - 1).Value Then
WSM.Range("D" & ToG).Value = ToG - 1
WSM.Range("E" & ToG).Value = WSM.Range("B" & BG).Value
ToG = ToG + 1
End If
Next
Range("A2:B2").Select
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("A2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
.SetRange Range("A2:B317")
.Orientation = xlTopToBottom
.Apply
End With
End Sub
Sub mondai9_02()
'↓範囲選択をしたときの操作。不要。
Columns("B:B").Select
'すべての並べ替え条件を初期化(でないと、以降の .add で新たに追加されるだけになってしまう)
ActiveWorkbook.Worksheets("main").Sort.SortFields.Clear
'並べ替え条件を追加
ActiveWorkbook.Worksheets("main").Sort.SortFields.Add Key:=Range("B1"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("main").Sort
'並べ替え範囲を指定↓
.SetRange Range("A2:B317")
'並べ替え方向を指定。(よく知らないけど、どうせ縦方向以外に、横方向とかあるのでしょう)
.Orientation = xlTopToBottom
'並べ替えを実施
.Apply
End With
Dim BG As Long
Dim BEG As Long
Dim WSM As Worksheet
Dim ToG As Long
Set WSM = Worksheets("main")
BEG = WSM.Range("B65536").End(xlUp).Row
ToG = 2
For BG = 2 To BEG
If WSM.Range("B" & BG).Value <> WSM.Range("B" & BG - 1).Value Then
WSM.Range("D" & ToG).Value = ToG - 1
WSM.Range("E" & ToG).Value = WSM.Range("B" & BG).Value
ToG = ToG + 1
End If
Next
'以下、もう少しこなれた表現をしてみた。
With ActiveWorkbook.Worksheets("main").Sort '←並べ替えについて
With .SortFields '←並べ替え列の設定を
.Clear '初期化する
.Add Key:=Range("A2"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal '追加する
End With
.SetRange Range("A2:B317") '範囲を指定
.Orientation = xlTopToBottom '方向を指定
.Apply '実施!
End With
End Sub
荏隈 直樹さんの投稿
(投稿ID: 327)
出来たことは出来たのですが、
Excel2010の自動記録が結構複雑で、どこを削ってよいか分からず、こんな長いマクロになってしまいました。
小川 慶一さんのコメント
(コメントID: 1115)
>Excel2010の自動記録が結構複雑で、どこを削ってよいか分からず、こんな長いマクロになってしまいました。
エクセル2007以降での自動記録でできあがるマクロについては、お送りしたテキスト(紙の冊子)の中に解読方法を詳しく書いています。
とはいえ、いただいたマクロについては、特に削らなくては、というところはありません。
以下に、簡単な解説とリライトを置きました。参考にしてください。
特に後半のは、言わんとしていることが直感的で分かりやすいかも。