vbaで二次元配列を複数条件で並び替える方法を教えてください。

画像

Visual Basic | Excel197閲覧xmlns="http://www.w3.org/2000/svg">500

ベストアンサー

0
画像

ThanksImg質問者からのお礼コメント

もっとも簡潔で、実装してみて検証も完ぺきにうまくいきましたのでこちらをベストアンサーとさせていただきました!ありがとうございました!

お礼日時:9/16 13:28

その他の回答(3件)

0

ID非公開

2021/9/13 9:18

Sheet1の2行目から10列のデータをユーザーフォームのリストボックスにソートして入れるコードです。 リストボックスのColumnCountは10に設定しておいて下さい。 列幅は適当な数値なので、変更して下さい。 Private Sub UserForm_Initialize() Dim tbl() As Variant Dim r As Long, rmax As Long Dim c As Integer Dim i As Long, j As Long Dim tmp(10) As Variant 'データを配列に入れる ReDim tbl(10, 0) With Worksheets("Sheet1") rmax = .Cells(Rows.Count, 1).End(xlUp).Row For r = 2 To rmax For c = 1 To 10 tbl(c - 1, UBound(tbl, 2)) = .Cells(r, c).Value Next c tbl(1, UBound(tbl, 2)) = Format(.Cells(r, 2).Value, "ge.m.d") tbl(3, UBound(tbl, 2)) = Format(.Cells(r, 4).Value, "h:mm") tbl(10, UBound(tbl, 2)) = .Cells(r, 2).Value + .Cells(r, 4).Value ReDim Preserve tbl(10, UBound(tbl, 2) + 1) Next r End With '配列を日付>時刻でソートする For i = 1 To UBound(tbl, 2) - 1 For j = UBound(tbl, 2) - 1 To i Step -1 If tbl(10, i) > tbl(10, j) Then For c = 0 To 10 tmp(c) = tbl(c, i) Next c For c = 0 To 10 tbl(c, i) = tbl(c, j) Next c For c = 0 To 10 tbl(c, j) = tmp(c) Next c End If Next j Next i 'ソート後の配列をリストボックスへ入れる With ListBox1 .ColumnWidths = "20;45;20;40;40;60;60;150;50;50" For r = 0 To UBound(tbl, 2) - 1 .AddItem "" For c = 0 To 9 .List(.ListCount - 1, c) = tbl(c, r) Next c Next r End With End Sub

ID非公開

2021/9/16 12:57

複数の回答があるのに何故どれにも対応しないのですか?

0

Public rs As Object Public Sub ソートしてリストボックスにセット() Set rs = CreateObject("ADODB.Recordset") Call フィールドをセット rs.Open Dim 元データ: 元データ = ActiveSheet.Range("A2:H9").Value Call 配列をレコードセットにセット(元データ) Call ソート("日付 ASC, 時刻 ASC") Dim 加工後データ 加工後データ = Recordsetを配列にセット ' UserForm1.ListBox1.List = 加工後データ rs.Close End Sub Public Sub フィールドをセット() With rs .Fields.Append "番号", 3, , 64 'adInteger 3 .Fields.Append "日付", 7, , 64 'adDate 7 .Fields.Append "曜日", 200, 255, 64 'adVarChar 200 .Fields.Append "時刻", 7, , 64 'adDate 7 .Fields.Append "業務番号", 3, , 64 'adInteger 3 .Fields.Append "対応", 200, 255, 64 'adVarChar 200 .Fields.Append "項目", 200, 255, 64 'adVarChar 200 .Fields.Append "内容", 200, 255, 64 'adVarChar 200 .CursorType = 1 ' adOpenKeyset .CursorLocation = 3 'adUseClient .LockType = 2 'adLockPessimistic End With End Sub Public Sub 配列をレコードセットにセット(indata) Dim i& For i = LBound(indata) To UBound(indata) With rs .AddNew .Fields("番号").Value = indata(i, 1) .Fields("日付").Value = indata(i, 2) .Fields("曜日").Value = indata(i, 3) .Fields("時刻").Value = indata(i, 4) .Fields("業務番号").Value = indata(i, 5) .Fields("対応").Value = indata(i, 6) .Fields("項目").Value = indata(i, 7) .Fields("内容").Value = indata(i, 8) .Update End With Next End Sub Public Sub ソート(sort_ As String) rs.Sort = sort_ End Sub Public Function Recordsetを配列にセット() Dim fieldCount&, rsCount& fieldCount = rs.Fields.count rsCount = rs.RecordCount ReDim ret(rsCount - 1, fieldCount - 1) Dim r&, c& While rs.EOF = False For c = 0 To fieldCount - 1 ret(r, c) = rs.Fields(c).Value Next r = r + 1 rs.movenext Wend Recordsetを配列にセット = ret End Function

画像

並べ替えの基準を変更する場合はここをいじる >ソート("日付 ASC, 時刻 ASC") ASC: 昇順 DESC: 降順

0

私には 二次元配列という意味は わかりません。 単純に結合を したままソートしたいということなら 添付の 下記の方法でも できます。 やり方は 単純です 一度結合をはずす。 I列に 日付と 時刻を足す ただし これには B列、D列に シリアル値が 入っていることが 条件です そして I列で ソート 再び 同じ列番号の A:G列間は 結合する 最後は I列を 削除 というマクロになります。 Application.DisplayAlerts = False Columns("A:G").UnMerge For I = 2 To Cells(Rows.Count, "A").End(xlUp).Row + 2 If Cells(I, "A") <> "" Then Cells(I, "I") = Cells(I, "B") + Cells(I, "D") Else Cells(I, "I") = Cells(I - 1, "I") End If Next Columns("A:I").Sort Key1:=Range("I1"), Order1:=xlAscending, Header:=xlYes For I = Cells(Rows.Count, "A").End(xlUp).Row + 2 To 2 Step -1 If Cells(I, "A") = "" Then For J = 1 To 7 Range(Cells(I - 1, J), Cells(I, J)).Merge Next End If Next Columns("I:I").Delete Shift:=xlToLeft Application.DisplayAlerts = True