質問編集履歴
2
不等号の向きが反対だった。多分
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -258,7 +258,7 @@
|
|
|
258
258
|
|
|
259
259
|
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))
|
|
260
260
|
|
|
261
|
-
If rtn
|
|
261
|
+
If rtn > 0 Then
|
|
262
262
|
|
|
263
263
|
tTmp = r_AryRow(j)
|
|
264
264
|
|
1
案の実装例を記載
test
CHANGED
|
File without changes
|
test
CHANGED
|
@@ -101,3 +101,177 @@
|
|
|
101
101
|
|
|
102
102
|
|
|
103
103
|
Office 365
|
|
104
|
+
|
|
105
|
+
|
|
106
|
+
|
|
107
|
+
### 追記
|
|
108
|
+
|
|
109
|
+
|
|
110
|
+
|
|
111
|
+
ソート用の列を追加するという上述の案の方針で
|
|
112
|
+
|
|
113
|
+
以下のような実装をしてみました。
|
|
114
|
+
|
|
115
|
+
このままではソートのアルゴリズムが遅いので、早いソートのアルゴリズムにすれば
|
|
116
|
+
|
|
117
|
+
少しは早くなりました。
|
|
118
|
+
|
|
119
|
+
|
|
120
|
+
|
|
121
|
+
|
|
122
|
+
|
|
123
|
+
```VBA
|
|
124
|
+
|
|
125
|
+
Public Sub CallSort(rRange As Range)
|
|
126
|
+
|
|
127
|
+
Dim tSheet As Worksheet
|
|
128
|
+
|
|
129
|
+
Set tSheet = rRange.Parent
|
|
130
|
+
|
|
131
|
+
Dim tRange As Range
|
|
132
|
+
|
|
133
|
+
Set tRange = rRange
|
|
134
|
+
|
|
135
|
+
|
|
136
|
+
|
|
137
|
+
tRange.Columns(tRange.Columns.Count + 1).Insert Shift:=xlToRight
|
|
138
|
+
|
|
139
|
+
|
|
140
|
+
|
|
141
|
+
Dim tCol1 As Range
|
|
142
|
+
|
|
143
|
+
Dim tCol2 As Range
|
|
144
|
+
|
|
145
|
+
Set tCol1 = tRange.Columns(1)
|
|
146
|
+
|
|
147
|
+
Set tCol2 = tRange.Columns(2)
|
|
148
|
+
|
|
149
|
+
|
|
150
|
+
|
|
151
|
+
Dim tV1 As Variant
|
|
152
|
+
|
|
153
|
+
Dim tV2 As Variant
|
|
154
|
+
|
|
155
|
+
|
|
156
|
+
|
|
157
|
+
Dim tR1 As Long
|
|
158
|
+
|
|
159
|
+
Dim tR2 As Long
|
|
160
|
+
|
|
161
|
+
Dim tC1 As Long
|
|
162
|
+
|
|
163
|
+
Dim tC2 As Long
|
|
164
|
+
|
|
165
|
+
|
|
166
|
+
|
|
167
|
+
|
|
168
|
+
|
|
169
|
+
tR1 = tRange.Row
|
|
170
|
+
|
|
171
|
+
tR2 = tR1 + tRange.Rows.Count - 1
|
|
172
|
+
|
|
173
|
+
tC1 = tRange.Column
|
|
174
|
+
|
|
175
|
+
tC2 = tC1 + tRange.Columns.Count
|
|
176
|
+
|
|
177
|
+
|
|
178
|
+
|
|
179
|
+
Set tRange = tSheet.Range(tSheet.Cells(tR1, tC1), tSheet.Cells(tR2, tC2))
|
|
180
|
+
|
|
181
|
+
|
|
182
|
+
|
|
183
|
+
tV1 = tCol1.Value
|
|
184
|
+
|
|
185
|
+
tV2 = tCol2.Value
|
|
186
|
+
|
|
187
|
+
|
|
188
|
+
|
|
189
|
+
ReDim tOrder(1 To UBound(tV1, 1))
|
|
190
|
+
|
|
191
|
+
ReDim tOrder2(1 To UBound(tV1, 1))
|
|
192
|
+
|
|
193
|
+
For tR = 1 To UBound(tV1, 1)
|
|
194
|
+
|
|
195
|
+
tOrder(tR) = tR
|
|
196
|
+
|
|
197
|
+
Next
|
|
198
|
+
|
|
199
|
+
|
|
200
|
+
|
|
201
|
+
MySort tOrder, tV1, tV2
|
|
202
|
+
|
|
203
|
+
|
|
204
|
+
|
|
205
|
+
For tR = 1 To UBound(tV1, 1)
|
|
206
|
+
|
|
207
|
+
tOrder2(tOrder(tR)) = tR
|
|
208
|
+
|
|
209
|
+
Next
|
|
210
|
+
|
|
211
|
+
|
|
212
|
+
|
|
213
|
+
tRange.Columns(tRange.Columns.Count).Value = WorksheetFunction.Transpose(tOrder2)
|
|
214
|
+
|
|
215
|
+
|
|
216
|
+
|
|
217
|
+
tSheet.Sort.SortFields.Clear
|
|
218
|
+
|
|
219
|
+
tSheet.Sort.SortFields.Add2 Key:=tRange.Columns(tRange.Columns.Count), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
|
|
220
|
+
|
|
221
|
+
With tSheet.Sort
|
|
222
|
+
|
|
223
|
+
.SetRange tRange
|
|
224
|
+
|
|
225
|
+
.Header = xlNo
|
|
226
|
+
|
|
227
|
+
.MatchCase = False
|
|
228
|
+
|
|
229
|
+
.Orientation = xlTopToBottom
|
|
230
|
+
|
|
231
|
+
.SortMethod = xlPinYin
|
|
232
|
+
|
|
233
|
+
.Apply
|
|
234
|
+
|
|
235
|
+
End With
|
|
236
|
+
|
|
237
|
+
tRange.Columns(tRange.Columns.Count).Delete Shift:=xlToLeft
|
|
238
|
+
|
|
239
|
+
|
|
240
|
+
|
|
241
|
+
End Sub
|
|
242
|
+
|
|
243
|
+
|
|
244
|
+
|
|
245
|
+
Public Sub MySort(r_AryRow As Variant, r_V1 As Variant, r_V2 As Variant)
|
|
246
|
+
|
|
247
|
+
Dim i As Long
|
|
248
|
+
|
|
249
|
+
Dim j As Long
|
|
250
|
+
|
|
251
|
+
Dim tTmp As Variant
|
|
252
|
+
|
|
253
|
+
For i = UBound(r_AryRow) To LBound(r_AryRow) + 1 Step -1
|
|
254
|
+
|
|
255
|
+
For j = LBound(r_AryRow) To i - 1
|
|
256
|
+
|
|
257
|
+
Dim rtn As Long
|
|
258
|
+
|
|
259
|
+
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))
|
|
260
|
+
|
|
261
|
+
If rtn < 0 Then
|
|
262
|
+
|
|
263
|
+
tTmp = r_AryRow(j)
|
|
264
|
+
|
|
265
|
+
r_AryRow(j) = r_AryRow(j + 1)
|
|
266
|
+
|
|
267
|
+
r_AryRow(j + 1) = tTmp
|
|
268
|
+
|
|
269
|
+
End If
|
|
270
|
+
|
|
271
|
+
Next
|
|
272
|
+
|
|
273
|
+
Next
|
|
274
|
+
|
|
275
|
+
End Sub
|
|
276
|
+
|
|
277
|
+
```
|