質問編集履歴
2
不等号の向きが反対だった。多分
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -128,7 +128,7 @@
|
|
|
128
128
|
For j = LBound(r_AryRow) To i - 1
|
|
129
129
|
Dim rtn As Long
|
|
130
130
|
rtn = Compare(r_V1(r_AryRow(j), 1), r_V2(r_AryRow(j), 1), r_V1(r_AryRow(j + 1), 1), r_V2(r_AryRow(j + 1), 1))
|
|
131
|
-
If rtn
|
|
131
|
+
If rtn > 0 Then
|
|
132
132
|
tTmp = r_AryRow(j)
|
|
133
133
|
r_AryRow(j) = r_AryRow(j + 1)
|
|
134
134
|
r_AryRow(j + 1) = tTmp
|
1
案の実装例を記載
title
CHANGED
|
File without changes
|
body
CHANGED
|
@@ -49,4 +49,91 @@
|
|
|
49
49
|
|
|
50
50
|
### 補足情報（FW/ツールのバージョンなど）
|
|
51
51
|
|
|
52
|
-
Office 365
|
|
52
|
+
Office 365
|
|
53
|
+
|
|
54
|
+
### 追記
|
|
55
|
+
|
|
56
|
+
ソート用の列を追加するという上述の案の方針で
|
|
57
|
+
以下のような実装をしてみました。
|
|
58
|
+
このままではソートのアルゴリズムが遅いので、早いソートのアルゴリズムにすれば
|
|
59
|
+
少しは早くなりました。
|
|
60
|
+
|
|
61
|
+
|
|
62
|
+
```VBA
|
|
63
|
+
Public Sub CallSort(rRange As Range)
|
|
64
|
+
Dim tSheet As Worksheet
|
|
65
|
+
Set tSheet = rRange.Parent
|
|
66
|
+
Dim tRange As Range
|
|
67
|
+
Set tRange = rRange
|
|
68
|
+
|
|
69
|
+
tRange.Columns(tRange.Columns.Count + 1).Insert Shift:=xlToRight
|
|
70
|
+
|
|
71
|
+
Dim tCol1 As Range
|
|
72
|
+
Dim tCol2 As Range
|
|
73
|
+
Set tCol1 = tRange.Columns(1)
|
|
74
|
+
Set tCol2 = tRange.Columns(2)
|
|
75
|
+
|
|
76
|
+
Dim tV1 As Variant
|
|
77
|
+
Dim tV2 As Variant
|
|
78
|
+
|
|
79
|
+
Dim tR1 As Long
|
|
80
|
+
Dim tR2 As Long
|
|
81
|
+
Dim tC1 As Long
|
|
82
|
+
Dim tC2 As Long
|
|
83
|
+
|
|
84
|
+
|
|
85
|
+
tR1 = tRange.Row
|
|
86
|
+
tR2 = tR1 + tRange.Rows.Count - 1
|
|
87
|
+
tC1 = tRange.Column
|
|
88
|
+
tC2 = tC1 + tRange.Columns.Count
|
|
89
|
+
|
|
90
|
+
Set tRange = tSheet.Range(tSheet.Cells(tR1, tC1), tSheet.Cells(tR2, tC2))
|
|
91
|
+
|
|
92
|
+
tV1 = tCol1.Value
|
|
93
|
+
tV2 = tCol2.Value
|
|
94
|
+
|
|
95
|
+
ReDim tOrder(1 To UBound(tV1, 1))
|
|
96
|
+
ReDim tOrder2(1 To UBound(tV1, 1))
|
|
97
|
+
For tR = 1 To UBound(tV1, 1)
|
|
98
|
+
tOrder(tR) = tR
|
|
99
|
+
Next
|
|
100
|
+
|
|
101
|
+
MySort tOrder, tV1, tV2
|
|
102
|
+
|
|
103
|
+
For tR = 1 To UBound(tV1, 1)
|
|
104
|
+
tOrder2(tOrder(tR)) = tR
|
|
105
|
+
Next
|
|
106
|
+
|
|
107
|
+
tRange.Columns(tRange.Columns.Count).Value = WorksheetFunction.Transpose(tOrder2)
|
|
108
|
+
|
|
109
|
+
tSheet.Sort.SortFields.Clear
|
|
110
|
+
tSheet.Sort.SortFields.Add2 Key:=tRange.Columns(tRange.Columns.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
|
|
111
|
+
With tSheet.Sort
|
|
112
|
+
.SetRange tRange
|
|
113
|
+
.Header = xlNo
|
|
114
|
+
.MatchCase = False
|
|
115
|
+
.Orientation = xlTopToBottom
|
|
116
|
+
.SortMethod = xlPinYin
|
|
117
|
+
.Apply
|
|
118
|
+
End With
|
|
119
|
+
tRange.Columns(tRange.Columns.Count).Delete Shift:=xlToLeft
|
|
120
|
+
|
|
121
|
+
End Sub
|
|
122
|
+
|
|
123
|
+
Public Sub MySort(r_AryRow As Variant, r_V1 As Variant, r_V2 As Variant)
|
|
124
|
+
Dim i As Long
|
|
125
|
+
Dim j As Long
|
|
126
|
+
Dim tTmp As Variant
|
|
127
|
+
For i = UBound(r_AryRow) To LBound(r_AryRow) + 1 Step -1
|
|
128
|
+
For j = LBound(r_AryRow) To i - 1
|
|
129
|
+
Dim rtn As Long
|
|
130
|
+
rtn = Compare(r_V1(r_AryRow(j), 1), r_V2(r_AryRow(j), 1), r_V1(r_AryRow(j + 1), 1), r_V2(r_AryRow(j + 1), 1))
|
|
131
|
+
If rtn < 0 Then
|
|
132
|
+
tTmp = r_AryRow(j)
|
|
133
|
+
r_AryRow(j) = r_AryRow(j + 1)
|
|
134
|
+
r_AryRow(j + 1) = tTmp
|
|
135
|
+
End If
|
|
136
|
+
Next
|
|
137
|
+
Next
|
|
138
|
+
End Sub
|
|
139
|
+
```
|