|
やっしー さん ,ichinose さん こんにちは。
ichinose さんのソースの方が高速そうなんで。。。不要かも知れませんが、
一応、自分のを変更したものをあげておきますね。
Sub TEST()
Dim Sort_Type() As String
Dim Ary()
'行の並べ替えの順を配列に格納
'Keyは1行目
For I = 1 To Cells(1, 256).End(xlToLeft).Column
ReDim Preserve Sort_Type(1 To I)
Sort_Type(I) = CStr(Cells(1, I).Value)
Next
'並べ替え実行は2行目から
For I = 2 To Cells(65000, 1).End(xlUp).Row Step 1
'配列要素の設定
ReDim Ary(1 To 1, 1 To UBound(Sort_Type))
'行内の列方向実行は最終列迄。
For X = 1 To Cells(I, 256).End(xlToLeft).Column
Vlu = Cells(I, X).Value
'対象セルが空白でなかった場合
If Vlu <> "" Then
FLG = False
Tmp_Int = IIf(InStr(1, CStr(Vlu), "=") = 0, Len(Vlu), Tmp_Int - 1)
'並び替え候補配列内要素と比較し、同じものが存在すれば、
'Ary配列の同一配列番号に値を格納
For V = 1 To UBound(Sort_Type)
If Sort_Type(V) = Trim(Left(CStr(Vlu), Tmp_Int)) Then
Ary(1, V) = Vlu
FLG = True
Exit For
End If
Next
'全ての並び替え候補配列内要素と一致しなかった場合、
'並び替え対象外の変数に値を格納
If Not FLG Then
Sort_Out = IIf(Sort_Out = "", Cells(I, X).Value, Sort_Out & "," & Cells(I, X).Value)
End If
End If
Next
'一旦行内の記載をクリア
Rows(I).ClearContents
'並び替え範囲に値を配列より各セルに転写
Range(Cells(I, 1), Cells(I, UBound(Sort_Type))) = Ary
'並び替え範囲の一つ横の列に配列対象外となった値を格納
Cells(I, UBound(Sort_Type) + 1) = Sort_Out
Sort_Out = ""
Next
End Sub
|
|