Excel VBAで並べ替えをしたい

Excel VBAについて

Sub mysort降順()
Dim mykey As Range
Dim myrug As Range
Set myrug = Range("C2:E17")
Set mykey = myrug.Columns(3)
Set myrug = 並べ替え(myrug, mykey)
End Sub


Function 並べ替え降順(myrug As Range, mykey As Range) As Range
Dim sorttest As Worksheet ' ソート対象のオブジェクトを指定
Set sorttest = ActiveSheet
With sorttest.Sort
.SortFields.Clear
.SortFields.Add Key:=mykey, _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.SetRange myrug
.Apply ' ソート実行
End With
End Function

このコードを利用して、降順でソートをかけたいのです。

昇順はできます。

↓のように変更しました。
Function 並べ替え降順(myrug As Range, mykey As Range) As Range
Dim sorttest As Worksheet ' ソート対象のオブジェクトを指定
Set sorttest = ActiveSheet
With sorttest.Sort
.SortFields.Clear
.SortFields.Add Key:=mykey, _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.SetRange myrug
.Apply ' ソート実行
End With
End Function

降順になりません。

降順のコードは、どこに仕込むのか、お手数ですがご、教示をお願いします。

No.2 ベストアンサー 回答者： kantansi 回答日時： 2023/02/25 10:19

現在のコードには、関数並べ替え降順がありますが、サブルーチンmysort降順でそれを呼び出す必要があります。

以下は、修正したコードです。

vbnet
Copy code
Sub mysort降順()
Dim mykey As Range
Dim myrug As Range

Set myrug = Range("C2:E17")
Set mykey = myrug.Columns(3)

' 降順の関数を呼び出す
Set myrug = 並べ替え降順(myrug, mykey)
End Sub

Function 並べ替え降順(myrug As Range, mykey As Range) As Range
Dim sorttest As Worksheet ' ソート対象のオブジェクトを指定

Set sorttest = ActiveSheet

With sorttest.Sort
.SortFields.Clear
.SortFields.Add Key:=mykey, _
SortOn:=xlSortOnValues, _
Order:=xlDescending, _
DataOption:=xlSortNormal
.SetRange myrug
.Apply ' ソート実行
End With

' 並び替えた範囲を返す
Set 並べ替え降順 = myrug
End Function
修正したコードでは、サブルーチン 'mysort降順myrugに代入しています。また、関数並べ替え降順の最後で、並び替えた範囲を返しています。

No.3 回答者： Qchan1962 回答日時： 2023/02/25 15:47

こんにちは

Sortメソッドの昇順、降順は引数のOrder1 * で行います
https://learn.microsoft.com/ja-jp/office/vba/api …

Functionを昇順、降順用に２つ用意する事も考えられますが
Functionの引数を増やす事でも対応できると思います

xlDescendingの実態（値は2です）
https://learn.microsoft.com/ja-jp/office/vba/api …

少し変なサンプルかも知れませんが・・
Sub mySort()
Dim mykey As Range
Dim myrug As Range
Set myrug = Range("C2:E17")
Set mykey = myrug.Columns(3)
Dim mySortOrder As Integer
Dim rc As VbMsgBoxResult
rc = MsgBox("Sortを実行します" & vbCrLf _
& "昇順は「はい」を" & vbCrLf _
& "降順は「いいえ」を" & vbCrLf _
& "押してください", vbYesNo + vbQuestion)
If rc = vbYes Then mySortOrder = 1 Else mySortOrder = 2
Set myrug = 並べ替え(ActiveSheet, myrug, mykey, mySortOrder)
MsgBox "C2セルの値は " & myrug.Item(1, 1) & " です"
End Sub

Function 並べ替え(sorttest As Worksheet, myrug As Range, _
mykey As Range, mySortOrder As Integer) As Range
With sorttest.Sort
.SortFields.Clear
.SortFields.Add Key:=mykey, _
SortOn:=xlSortOnValues, _
Order:=mySortOrder, _
DataOption:=xlSortNormal
.SetRange myrug
.Apply ' ソート実行
End With
Set 並べ替え = myrug
End Function

この回答へのお礼

素晴らしいサンプルありがとうございました。

お礼日時：2023/02/25 19:23

No.1 回答者： tatsumaru77 回答日時： 2023/02/25 09:39

Set myrug = 並べ替え(myrug, mykey)　

を
Set myrug = 並べ替え降順(myrug, mykey)
に変更してください。

この回答へのお礼

回答ありがとうございました。

お礼日時：2023/02/25 19:23