エクセルVBAでデータ並べ替え

質問

マクロ記録をとると次のようになりました。
これをA列をキーに並べるもっと簡単なコードを教えてください。
Range("A2:G501")となっていますが、これ以上でも対応できるようにしたいです。

どなたか教えていただけないでしょうか。

Sub Macro1()

Range("A1").Select
ActiveWorkbook.Worksheets("***").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("***").Sort.SortFields.Add Key:=Range("A1"), SortOn _
:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("***").Sort
.SetRange Range("A2:G501")
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

回答No.4

keithin · ベストアンサー

次のようでしょうか。

.Range("A1").CurrentRegion.Sort _
key1:=.Range("A1"), _
order1:=xlAscending, _
Header:=xlYes

key1:=の部分を書き換えているのを見落とさないように。
違うシートを並べ替えるなら確実に「どのシートの」を漏れなく修飾します。

お礼

ありがとうございました。できました！

回答No.3

imogasi

列でソートなら
Sub test01()
Columns("A:A").Sort , Key1:=Range("A1"), Order1:=xlAscending
End Sub
で良いのでは。（一番簡単ということなら）
もちろん同類データの最終行の次以下に異質のデータが在れば使えないが。
ーー
マクロの記録が２００３までと違うようだ。
質問には、エクセルのバージョンを書くのは常識だよ。

回答No.2

keithin

sub macro2()
　worksheets("シート名").range("A1").currentregion.sort _
　　key1:=range("A1"), _
　　order1:=xlascending, _
　　header:=xlyes
end sub
などで。

お礼

keithinさんご回答ありがとうございました。
並べ替えを下のコードに組み込んで実行したいと思っています。'--------の部分です。
エラーが出るのですが、意味がわかりません。エラーの内容は、
[並べ替えの参照が正しくありません。参照が並べ替えるデータ内にあることと「最優先されるキーボックス」が空白でないことを確認してください]という表示が出ます。

この場合どうしたらいいでしょうか？

With Sheets(sh.Range("D4").Value)
r = .Cells(.Rows.Count, 1).End(xlUp).Row + 1
.Range("A" & r).Resize(n).Value = sh.Range("F10").Resize(n).Value
.Range("B" & r).Resize(n, 3).Value = sh.Range("C10").Resize(n, 3).Value
.Range("F" & r).Resize(n).Value = sh.Range("D6").Value
'----------------------
.Range("A1").CurrentRegion.Sort _
key1:=Range("A1"), _
order1:=xlAscending, _
Header:=xlYes
'----------------------
End With

補足

たびたびすみません。
ひとつひとつコードを実行してみると、エラーなしに最後までいきます。(並べ替えできています)
わからないですが、何かワンクッション的なものが必要なのでしょうか？

回答No.1

system0002

ソートしたデータの先頭のデータを選択して以下のコードを実行して下さい。
昇順用と降順用のマクロです。

Sub 昇順にソート()
Dim i As Long
Dim j As Long
Dim temp As Long

Dim sortedcolumn As Long
Dim firstrow As Long
Dim lastrow As Long

With Selection
sortedcolumn = .Column
firstrow = .Row
lastrow = .End(xlDown).Row
End With

For i = firstrow To lastrow - 1
For j = i + 1 To lastrow
If Cells(i, sortedcolumn) > Cells(j, sortedcolumn) Then
temp = Cells(i, sortedcolumn)
Cells(i, sortedcolumn) = Cells(j, sortedcolumn)
Cells(j, sortedcolumn) = temp
End If
Next
Next

MsgBox "昇順に並べ替えました。"

End Sub

Sub 降順にソート()
Dim i As Long
Dim j As Long
Dim temp As Long

Dim sortedcolumn As Long
Dim firstrow As Long
Dim lastrow As Long

With Selection
sortedcolumn = .Column
firstrow = .Row
lastrow = .End(xlDown).Row
End With

For i = firstrow To lastrow - 1
For j = i + 1 To lastrow
If Cells(i, sortedcolumn) < Cells(j, sortedcolumn) Then
temp = Cells(i, sortedcolumn)
Cells(i, sortedcolumn) = Cells(j, sortedcolumn)
Cells(j, sortedcolumn) = temp
End If
Next
Next

MsgBox "降順に並べ替えました。"

End Sub