| |
▼やっしー さん：
> A列 B C D E
>★ Q1 Q2 Q3 Q4 Q5
>
>● Q1 Q2 Q3 Q5 Q5
> Q1 Q2 Q4 Q5 Q6
> Q1 Q2 Q4 Q6 Q7
> Q1 Q2 Q4 Q4 Q5
> : Q2 Q3 Q6 Q5
> : : Q4 : Q7
> : : : : Q6
>
>またまたお尋ねします。
>
>上の図のように●行目から同じQ数字に整列されていないQ数字がある場合、
>
>★行の同じQ数字に合わせて整列させることはできますか？
'質問の意図をきちんと把握しきれていないのかも知れないですが・・・。
'２つ目以降は無視（削除）していいのであれば、
'以下の様な方法が考えられるかと思います｡
'
'他にもいい方法があると思いますので､
'こんな方法もある程度に参考程度にして下さい。
'ここでは配列番号が、対応する列番号になる様にﾌﾟﾛｸﾞﾗﾑを組んであります。
'
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
'対象セルが空白でなかった場合
If Cells(I, X).Value <> "" Then
FLG = False
'並び替え候補配列内要素と比較し、同じものが存在すれば、
'Ary配列の同一配列番号に値を格納
For V = 1 To UBound(Sort_Type)
If Sort_Type(V) = CInt(Cells(I, X).Value) Then
Ary(1, V) = Sort_Type(V)
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
並び替え範囲に値を配列より各セルに転写
Range(Cells(I, 1), Cells(I, UBound(Sort_Type))) = Ary
'並び替え範囲の一つ横の列に配列対象外となった値を格納
Cells(I, UBound(Sort_Type) + 1) = Sort_Out
Sort_Out = ""
Next
End Sub
|
|
kazu
- 04/11/29(月) 14:19 -
