こんにちは。
条件
・Excel2003(最近のご質問を検索したところ、Excel2003らしいので)
バージョン互換、未検証。
Excel2007 以降のバージョンでは、
.Sort メソッドではなく、.Sort オブジェクトが推奨されています。
・シート名="Sheet1" ' ■
・セル範囲参照="A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row ' ■
・コントロールのオグジェクト名
添付画像、左から
ListBox1 ' ■ ' ■■
SpinButton1 ' ■■
ListBox2 ' ■ ' ■■
SpinButton2 ' ■■
・コマンドボタンを追加
オブジェクト名=CommandButton1 ' ■■
※SpinUp、SpinDown、に連動してListBoxをソート、
CommandButton1_Click、のタイミングでListBoxの順にシートデータをソート。
SpinButtonから直接シートデータをソートするのは(出来るには出来るけれど)
煩雑過ぎてトラブルの元になるという判断です。
技術的なポイントとしては
Scripting.Dictionary
Application.AddCustomList
.CustomListCount
.DeleteCustomList
.Sort Kメソッドの 名前付き引数 OrderCustom
等です。
独自に理解を深めるようにしてください。
解説が必要な部分があるということなら要望あればお応えするかも知れませんが、
使用環境や要求仕様に纏わる"オカワリ"については、
このスレの補足欄に書かれたとしても
(適切な補足がそんなに簡単にできるものではないでしょうから)
お応えできないものとお考えの上、先ずは自力応用に努めて下さい。
テストの際の注意事項。
下記サンプルを、モジュール内に他に記述がない状態で試す方が
紛れがなくて無難です。
Excel2003 環境で、動作確認、検証済です。
運用に合わせて要指定
値を指定 ' ■
オブジェクト名を指定 ' ■■
参照設定はオプションです。 ' ▲
' ' =========== UserForm モジュール ==========
' ' 参照設定 : Microsoft Scripting Runtime ' ▲
' ' ーーーー モジュール(先頭)宣言部 ーーーーー
' ' ーーーーーーーーーーーーーーーーーーーーーーー
Option Explicit ' 8351979
Private Const シート名 As String = "Sheet1" ' ■
Private セル範囲参照 As String ' タイトル行除く
Private Const リスト1 As String = "ListBox1" ' ■
Private Const リスト2 As String = "ListBox2" ' ■
Private Enum MySpinDir
mySpinUp = -1
mySpinDown = 1
End Enum
Private ListBoxes(1 To 2) As MSForms.ListBox
Private arrCnList(1 To 2) As Long
' ' ーーーーーーーーーーーーーーーーーーーーーーー
Private Sub UserForm_Initialize()
Dim oDict As Object ' Dim oDict As Scripting.Dictionary ' ▲
Dim mtxSrc()
Dim i As Long
With Sheets(シート名)
セル範囲参照 = "A2:C" & .Cells(Rows.Count, "A").End(xlUp).Row ' ■タイトル行除く
mtxSrc() = .Range(セル範囲参照).Resize(, 2).Value
End With
Set oDict = CreateObject("Scripting.Dictionary") ' Set oDict = New Scripting.Dictionary ' ▲
For i = 1 To UBound(mtxSrc)
oDict(mtxSrc(i, 1)) = Empty
Next i
arrCnList(1) = oDict.Count
Set ListBoxes(1) = Me.Controls(リスト1)
ListBoxes(1).List = oDict.Keys
ListBoxes(1).ListIndex = 0
oDict.RemoveAll
For i = 1 To UBound(mtxSrc)
oDict(mtxSrc(i, 2)) = Empty
Next i
arrCnList(2) = oDict.Count
Set ListBoxes(2) = Me.Controls(リスト2)
ListBoxes(2).List = oDict.Keys
ListBoxes(2).ListIndex = 0
Set oDict = Nothing: Erase mtxSrc()
End Sub
Private Sub SpinSort(ByVal nBoxIndex As Long, _
ByVal SpinDir As MySpinDir)
Dim sBuf
Dim nListIndex As Long
With ListBoxes(nBoxIndex)
nListIndex = .ListIndex
Select Case SpinDir
Case mySpinUp
If nListIndex = 0 Then Exit Sub
Case mySpinDown
If nListIndex >= arrCnList(nBoxIndex) - 1 Then Exit Sub
End Select
sBuf = .Value
.List(nListIndex) = .List(nListIndex + SpinDir)
.List(nListIndex + SpinDir) = sBuf
.ListIndex = nListIndex + SpinDir
End With
End Sub
Private Sub SpinButton1_SpinUp() ' ■■
SpinSort 1, mySpinUp
End Sub
Private Sub SpinButton1_SpinDown() ' ■■
SpinSort 1, mySpinDown
End Sub
Private Sub SpinButton2_SpinUp() ' ■■
SpinSort 2, mySpinUp
End Sub
Private Sub SpinButton2_SpinDown() ' ■■
SpinSort 2, mySpinDown
End Sub
Private Sub CommandButton1_Click() ' ■■
Dim cnCustomList As Long
With Application
.AddCustomList ListBoxes(1).List
.AddCustomList ListBoxes(2).List
cnCustomList = .CustomListCount
With Sheets(シート名).Range(セル範囲参照)
.Sort Key1:=.Cells(1), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=cnCustomList, _
MatchCase:=True, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal
.Sort Key1:=.Cells(2), Order1:=xlAscending, _
Header:=xlNo, OrderCustom:=cnCustomList + 1, _
MatchCase:=True, Orientation:=xlTopToBottom, _
SortMethod:=xlStroke, DataOption1:=xlSortNormal
End With
.DeleteCustomList (cnCustomList)
.DeleteCustomList (cnCustomList - 1)
End With
End Sub
お礼
回答ありがとうございます。 ただいまとても忙しく、確認できない状況ですが、 時間を作って早めに確認しようと思います! もっとVBAについての知識を深めたいと思います。