teratail header banner
teratail header banner
質問するログイン新規登録

回答編集履歴

1

サンプルコードの修正

2015/11/05 11:58

投稿

pi-chan
pi-chan

スコア5936

answer CHANGED
@@ -126,4 +126,156 @@
126
126
  Set xlBook = Nothing
127
127
 
128
128
  End Sub
129
- ```
129
+ ```
130
+
131
+ ---
132
+ <コード修正:2015/11/05 22:56>
133
+
134
+ お待たせ致しました。コードを修正致しましたので、再度ご確認頂けますか?
135
+ ```
136
+ Option Explicit
137
+
138
+
139
+
140
+ '------------------------------------------------------------------------------
141
+ ' 正規表現による文字列置換
142
+ '------------------------------------------------------------------------------
143
+ Function RegReplace(strTarget As String, _
144
+ strPattern As String, _
145
+ strReplaced As String, _
146
+ Optional blnGlobal As Boolean = False) As String
147
+
148
+ Dim objRex As Object
149
+
150
+ Set objRex = CreateObject("VBScript.RegExp")
151
+
152
+ objRex.Pattern = strPattern
153
+ objRex.Global = blnGlobal
154
+ RegReplace = objRex.Replace(strTarget, strReplaced)
155
+
156
+
157
+ Set objRex = Nothing
158
+
159
+ End Function
160
+
161
+
162
+
163
+ '------------------------------------------------------------------------------
164
+ ' 正規表現によるマッチング
165
+ '------------------------------------------------------------------------------
166
+ Function RegMatch(strTarget As String, _
167
+ strPattern As String) As Boolean
168
+
169
+ Dim objRex As Object
170
+
171
+ Set objRex = CreateObject("VBScript.RegExp")
172
+
173
+ objRex.Pattern = strPattern
174
+ RegMatch = objRex.Test(strTarget)
175
+
176
+
177
+ Set objRex = Nothing
178
+
179
+ End Function
180
+
181
+
182
+
183
+ '------------------------------------------------------------------------------
184
+ ' 対象データの並べ替え
185
+ '------------------------------------------------------------------------------
186
+ Sub CustomSort()
187
+
188
+ Dim xlBook As Workbook
189
+ Dim xlSheet As Worksheet
190
+ Dim vntTarget As Variant
191
+ Dim strOrder() As String
192
+ Dim o As Long
193
+ Dim i As Long
194
+ Dim j As Long
195
+ Dim k As Long
196
+ Dim l As Long
197
+
198
+ Set xlBook = ThisWorkbook
199
+ Set xlSheet = xlBook.Worksheets("Sheet1")
200
+
201
+ ' 文字列部の並び順の指定
202
+ i = 1
203
+ ReDim Preserve strOrder(i)
204
+ strOrder(i) = "Z"
205
+ '
206
+ i = i + 1
207
+ ReDim Preserve strOrder(i)
208
+ strOrder(i) = "WX"
209
+ '
210
+ i = i + 1
211
+ ReDim Preserve strOrder(i)
212
+ strOrder(i) = "ST"
213
+ '
214
+ i = i + 1
215
+ ReDim Preserve strOrder(i)
216
+ strOrder(i) = "UV"
217
+ '
218
+ i = i + 1
219
+ ReDim Preserve strOrder(i)
220
+ strOrder(i) = "Y"
221
+
222
+ ' ソート結果出力先の列番号
223
+ o = 1
224
+
225
+ With xlSheet
226
+ ' ソート対象の領域を配列に読み込み
227
+ vntTarget = .Range(.Cells(1, 1), .Cells(Rows.Count, 2).End(xlUp))
228
+
229
+ ' アルファベット部のソート順にブロック化した際の開始行と最終行の行番号を初期化
230
+ k = 1
231
+ l = 1
232
+
233
+ ' 文字列部の並び順に数値部の昇順にソートする
234
+ For i = 1 To 5
235
+ ' 文字列部の並び順にブロック化
236
+ For j = 1 To UBound(vntTarget, 1)
237
+ If RegMatch(CStr(vntTarget(j, 1)), "^" & strOrder(i) & "[0-9]") Then
238
+ .Cells(l, o).Value = CStr(vntTarget(j, 1))
239
+ .Cells(l, o + 1).Value = CStr(vntTarget(j, 2))
240
+ .Cells(l, o + 2).Value = RegReplace(CStr(vntTarget(j, 1)), "[A-Za-z]+", "", True)
241
+ l = l + 1
242
+ End If
243
+ Next j
244
+
245
+ ' ブロック毎に数値順にソート
246
+ .Range(.Cells(k, o), .Cells(l - 1, o + 2)).Sort _
247
+ key1:=.Cells(k, 3), _
248
+ Order1:=xlAscending, _
249
+ Header:=xlNo, _
250
+ OrderCustom:=1, _
251
+ MatchCase:=False, _
252
+ Orientation:=xlTopToBottom, _
253
+ SortMethod:=xlPinYin, _
254
+ DataOption1:=xlSortTextAsNumbers
255
+
256
+ ' ソート用に使用した数値列を削除
257
+ .Range(.Cells(k, o + 2), .Cells(l - 1, o + 2)).ClearContents
258
+ k = l
259
+ Next i
260
+ End With
261
+
262
+
263
+ Set xlSheet = Nothing
264
+ Set xlBook = Nothing
265
+
266
+ End Sub
267
+ ```
268
+
269
+ 改善点は2箇所です。
270
+
271
+ まず、ソートそのものに関する改善は下記1行のみです。
272
+ `If RegMatch(CStr(vntTarget(j, 1)), "^" & strOrder(i) & "[0-9]") Then`
273
+ ソートの基準になる「英字部分」のマッチングで、余計な文字列がマッチしてしまわぬよう「正規表現」を以下のように変更しました。
274
+ ```
275
+ 修正前)strOrder(i)
276
+ 修正後)"^" & strOrder(i) & "[0-9]" ← 文字列の「先頭」〜「最初の数字」までをマッチング
277
+ ```
278
+
279
+ もう一箇所はついで(本質的ではない)ですが、ソートの基準になる英文字部分の定義に「動的配列」を使用することで、追加や順序の入れ替えを楽に出来るようにしてみました。
280
+
281
+ 以上、ご参考になれば幸いです。