『2010で多数条件で並び替えをしたい』（YS）
質問させて頂きます
表がありまして、その表のデータの並び替えをしたのですがエクセル2010ですのでSORT関数が使えません。また並び替えコマンドも試しましたが、ワードを直接指定することは出来ないため不可能でした。
A列に名前、B列に日付、C列以降その他のデータが、F列まで入っています
並び替えの条件ですがA列を指定したワード（完全一致）で参照し行を抽出します、複数の行が抽出された場合、B列の日付が古い順から順に並び替える、という事をしたいです。A列を参照するワードは都度個数もワード自体も変わりますて、10個から100個のくらいの範囲になりそうです。参照ワードのリストを作っておいてリストを上から順に参照して検索していくようなことが出来ればと思います。
並び替えで質問させて頂きましたが、他の場所やシートに並び替えた結果を表示させても良いですし他の方法でも構いません。並び替えで質問しましたが、A列に指定したワードがある行全てを抽出し、B列の日付が古い順に並び替えて表示させる、という感じです。無ければ無視です。次に2番目のワードで同じことをし、先のワードの下から順に表示させるという感じです。最後に指定したワード全てに当てはまらなかった行すべてを違うシート等に表示させたいです
宜しくお願い致します
＜ 使用 Excel：Excel2010、使用 OS：Windows11 ＞
「並び替え」と「フィルターの詳細設定」を利用 （マナ） 2025/05/11(日) 07:46:13
A列の「名前」列をキーワードリストで検索。完全一致。
該当行を抽出。複数該当があればB列の日付順（昇順）で並び替え。
キーワードリストの上から順に処理し、該当行を1つの表に結合表示。
キーワードに該当しなかった行は別のシートに出力。
希望を一度に自動で行うには、VBAの利用がマストとなります。
コードは、未検証なので適宜変更下さい。
KeywordListシートのキーワードは A列に上から順に書き出す事
（1行目は見出しでもOK）
Sub test()
Dim wsSource As Worksheet, wsKeywords As Worksheet
Dim wsFiltered As Worksheet, wsNotMatched As Worksheet
Dim lastRow As Long, keyLastRow As Long
Dim i As Long, j As Long, outRow As Long
Dim keyword As String
Dim rngSource As Range, cell As Range
Dim dictMatched As Object
Dim rngMatched As Range
Dim matchFound As Boolean
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set dictMatched = CreateObject("Scripting.Dictionary")
' シート設定
Set wsSource = Worksheets("Sheet1")
Set wsKeywords = Worksheets("KeywordList")
' 出力シート初期化
On Error Resume Next
Worksheets("FilteredData").Delete
Worksheets("NotMatched").Delete
On Error GoTo 0
Set wsFiltered = Worksheets.Add
wsFiltered.Name = "FilteredData"
Set wsNotMatched = Worksheets.Add
wsNotMatched.Name = "NotMatched"
' 元データの最終行
lastRow = wsSource.Cells(wsSource.Rows.Count, 1).End(xlUp).Row
keyLastRow = wsKeywords.Cells(wsKeywords.Rows.Count, 1).End(xlUp).Row
' ヘッダーコピー
wsSource.Range("A1:F1").Copy Destination:=wsFiltered.Range("A1")
wsSource.Range("A1:F1").Copy Destination:=wsNotMatched.Range("A1")
outRow = 2
' 各キーワード処理
For i = 2 To keyLastRow
keyword = Trim(wsKeywords.Cells(i, 1).Value)
If keyword <> "" Then
For j = 2 To lastRow
If wsSource.Cells(j, 1).Value = keyword Then
If Not dictMatched.exists(j) Then
dictMatched.Add j, True
End If
End If
Next j
End If
Next i
' 抽出して配列に格納 → 並び替え
Dim tmpArr() As Variant
Dim matchCount As Long: matchCount = 0
For Each j In dictMatched.Keys
matchCount = matchCount + 1
Next
If matchCount > 0 Then
ReDim tmpArr(1 To matchCount, 1 To 6)
i = 1
For Each j In dictMatched.Keys
For k = 1 To 6
tmpArr(i, k) = wsSource.Cells(j, k).Value
Next k
i = i + 1
Next
' 日付（2列目）で並び替え
Dim sortedArr() As Variant
sortedArr = SortByDate(tmpArr, 2)
' 再配置（キーワード順で処理）
outRow = 2
For i = 2 To keyLastRow
keyword = Trim(wsKeywords.Cells(i, 1).Value)
If keyword <> "" Then
For j = LBound(sortedArr) To UBound(sortedArr)
If sortedArr(j, 1) = keyword Then
For k = 1 To 6
wsFiltered.Cells(outRow, k).Value = sortedArr(j, k)
Next k
outRow = outRow + 1
End If
Next j
End If
Next i
End If
' 一致しなかった行
outRow = 2
For j = 2 To lastRow
If Not dictMatched.exists(j) Then
For k = 1 To 6
wsNotMatched.Cells(outRow, k).Value = wsSource.Cells(j, k).Value
Next k
outRow = outRow + 1
End If
Next j
MsgBox "処理が完了しました！", vbInformation
Application.ScreenUpdating = True
End Sub
'日付で並び替え
Function SortByDate(arr As Variant, dateCol As Integer) As Variant
Dim i As Long, j As Long, temp As Variant
Dim rowCount As Long
rowCount = UBound(arr)
For i = 1 To rowCount - 1
For j = i + 1 To rowCount
If arr(i, dateCol) > arr(j, dateCol) Then
temp = arr(i, dateCol)
arr(i, dateCol) = arr(j, dateCol)
arr(j, dateCol) = temp
temp = arr(i)
arr(i) = arr(j)
arr(j) = temp
End If
Next j
Next i
SortByDate = arr
End Function
（暇な人） 2025/05/11(日) 07:50:21
マナさんの提案について、イメージ図を書いて見ました。 簡単な手作業でできます。（頻繁に実行するなら、マクロ記録をもとにマクロも作れます。）
(a)元データ (b)日付順にソートしておく (c)「フィルターの詳細設定」を使った抽出 (d)もし項目別でまとめたいなら、
ソートキーに"ユーザー定義リスト"を指定してソートすれば可。
↓検索条件の指定 ↓抽出結果 （作成日の昇順は保存される）
------------------- -------------------- ------ ------------------- ---------------------------
項目 作成日 項目 作成日 項目 項目 作成日 項目 作成日
ab 2025/5/11 yy 2025/4/30 ab ab 2025/5/1 ab 2025/5/1
xx 2025/5/10 zz 2025/4/30 xx xx 2025/5/2 ab 2025/5/11
yy 2025/4/30 ab 2025/5/1 xx 2025/5/10 xx 2025/5/2
ab 2025/5/1 xx 2025/5/2 ab 2025/5/11 xx 2025/5/10
xx 2025/5/2 xx 2025/5/10
zz 2025/4/30 ab 2025/5/11
（xyz） 2025/05/11(日) 08:44:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.