配列の並び替え

質問

下のように５つの配列がA～E列まであって、2、3行目にデータが入っています。このときに、2行目の値が3行目の値より小さい配列で、かつ、2行目の値が小さい順に並べる。その後に、3行目より、2行目の値の方が大きい配列を3行目の値が大きい順に並べるマクロコードを教えてください。

　　A B C D E←列 　　 　

1　　1　2　3　4　5←配列番号
2　　4　9　8　6　2
3　　1　5　7　10　3 　　 　
↑
行
　　　↓

　　A B C D E

1　　5　4　3　2　1
2　　2　6　8　9　4
3　　3　10　7　5　1

回答No.4

BLUEPIXY · ベストアンサー

＃３＞実際は上のように5行目、Ｂ列からデータを入力して実行したので…
結局（お互いに）遠回りになるので、最初から実際に即して質問された方がいいかもしれません。。
Sample プロシージャ を処理データの基点と出力位置の基点で動作するように変更してみました。
＞Const 基準セル = "B5"
＞Const 出力基準セル = "A1"
の部分を変えれば、入力データは、"基準セル"(例で言うとＢ５)を基点(左上)として始まり
出力位置は"出力基準セル"(例で言うとＡ１)を基準とするようになります。
＃３の補足で書かれたような変更もできないではないですが、
(私見ですが)あまり良い方法とは思えません。
----------------------------------------------------------------
Public Sub sample()
Const 行数 = 3
Const 基準セル = "B5"
Const 出力基準セル = "A1"
Dim 列数 As Integer
Dim a(), x
Dim i, wk
Dim swap As Boolean
Dim base As Range

Sheets("Sheet1").Select
Set base = Range(基準セル)
列数 = base.End(xlToRight).Column ' 基準セルからデータが連続していること

ReDim a(行数, 列数)
a = Range(base, base.Offset(行数 - 1, 列数 - 1)).Value

Application.ScreenUpdating = False
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test1(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then
'条件が成立したら、交換する
wk = a(1, i): a(1, i) = a(1, i - 1): a(1, i - 1) = wk
wk = a(2, i): a(2, i) = a(2, i - 1): a(2, i - 1) = wk
wk = a(3, i): a(3, i) = a(3, i - 1): a(3, i - 1) = wk
swap = True
End If
Next
Loop
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test2(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then
'条件が成立したら、交換する
wk = a(1, i): a(1, i) = a(1, i - 1): a(1, i - 1) = wk
wk = a(2, i): a(2, i) = a(2, i - 1): a(2, i - 1) = wk
wk = a(3, i): a(3, i) = a(3, i - 1): a(3, i - 1) = wk
swap = True
End If
Next
Loop
Sheets("Sheet2").Select '出力シート
Set base = Range(出力基準セル)
Range(base, base.Offset(行数 - 1, 列数 - 1)) = a

Application.ScreenUpdating = True
End Sub

お礼

ありがとうございました。
無事に実行することができました。

回答No.3

BLUEPIXY

#2>このマクロコードを実行すると、…うまく実行することができませんが、どのような原因があるのでしょうか？
ウチの環境(excel2002)では、問題なく実行できています。
何か変更されましたでしょうか？
＞If change_test1(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then
で
＞「インデックスが有効範囲にありません」
と言うメッセージがでるとすると、配列 a の範囲を超える添字を指定したということになりますが、
ReDim a(行数, 列数)
であり、
For i = 列数 To 2 Step -1
ですから、
配列範囲外にはなるはずがないと思えます。
デバッグで止まった時に i の値はいくつになっていますか？

補足

B　C　D　E　F　列
(5)　1　2　3　4　5
(6)　4　9　8　6　2
(7)　3　10　7　5　1
行

実際は上のように5行目、Ｂ列からデータを入力して実行したので、const 行列=3を行列=7にして、
For i = 列数 To 2 Step -1
If change_test1(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then　を
For i = 列数 To 2 Step -1
If change_test1(a(6, i - 1), a(7, i - 1), a(6, i), a(7, i)) Then
に変更しました。
デバッグ時のiは６になっています。

回答No.2

BLUEPIXY

#1>配列数が任意の値ｎのときで、sheet2に並び替えた配列を表示させる
と言うわけで修正してみました。
Sheet1 のＡ１からｎ列までのデータを処理してSheet2 に書き出します
----------------------------------------------------------------
Public Sub sample()
Const 行数 = 3
Dim 列数 As Integer
Dim a(), x
Dim i, wk
Dim swap As Boolean

Sheets("Sheet1").Select
列数 = Range("A1").End(xlToRight).Column ' Ａ１からデータが連続していること

ReDim a(行数, 列数)
a = Range(Cells(1, 1), Cells(行数, 列数)).Value

Application.ScreenUpdating = False
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test1(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then
'条件が成立したら、交換する
wk = a(1, i): a(1, i) = a(1, i - 1): a(1, i - 1) = wk
wk = a(2, i): a(2, i) = a(2, i - 1): a(2, i - 1) = wk
wk = a(3, i): a(3, i) = a(3, i - 1): a(3, i - 1) = wk
swap = True
End If
Next
Loop
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test2(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then
'条件が成立したら、交換する
wk = a(1, i): a(1, i) = a(1, i - 1): a(1, i - 1) = wk
wk = a(2, i): a(2, i) = a(2, i - 1): a(2, i - 1) = wk
wk = a(3, i): a(3, i) = a(3, i - 1): a(3, i - 1) = wk
swap = True
End If
Next
Loop
Sheets("Sheet2").Select
Range(Cells(1, 1), Cells(行数, 列数)) = a

Application.ScreenUpdating = True
End Sub

'2行目の値が3行目の値より小さい配列で、かつ、2行目の値が小さい順
Private Function change_test1(a2, a3, b2, b3) As Boolean
If b2 < b3 And (a2 >= a3 Or a2 < a3 And a2 > b2) Then
change_test1 = True
Else
change_test1 = False
End If
End Function

'3行目より、2行目の値の方が大きい配列を3行目の値が大きい順
Private Function change_test2(a2, a3, b2, b3) As Boolean
If b2 >= b3 And a2 >= a3 And a3 < b3 Then
change_test2 = True
Else
change_test2 = False
End If
End Function

補足

このマクロコードを実行すると、
「実行時エラー"9"
　インデックスが有効範囲にありません」と、表示されディバックすると
If change_test1(a(2, i - 1), a(3, i - 1), a(2, i), a(3, i)) Then　のところが選択されてしまい、うまく実行することができませんが、どのような原因があるのでしょうか？

回答No.1

BLUEPIXY

Public Sub sample()
Const 列数 = 5, 行数 = 3
Dim a(), x
Dim i, wk
Dim swap As Boolean

ReDim a(行数, 列数)
a = Range(Cells(1, 1), Cells(行数, 列数))

Application.ScreenUpdating = False
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test1(Cells(2, i - 1).Value, Cells(3, i - 1), Cells(2, i).Value, Cells(3, i).Value) Then
'条件が成立したら、交換する
wk = Cells(1, i).Value: Cells(1, i).Value = Cells(1, i - 1).Value: Cells(1, i - 1).Value = wk
wk = Cells(2, i).Value: Cells(2, i).Value = Cells(2, i - 1).Value: Cells(2, i - 1).Value = wk
wk = Cells(3, i).Value: Cells(3, i).Value = Cells(3, i - 1).Value: Cells(3, i - 1).Value = wk
swap = True
End If
Next
Loop
swap = True
Do While swap
swap = False
For i = 列数 To 2 Step -1
If change_test2(Cells(2, i - 1).Value, Cells(3, i - 1), Cells(2, i).Value, Cells(3, i).Value) Then
'条件が成立したら、交換する
wk = Cells(1, i).Value: Cells(1, i).Value = Cells(1, i - 1).Value: Cells(1, i - 1).Value = wk
wk = Cells(2, i).Value: Cells(2, i).Value = Cells(2, i - 1).Value: Cells(2, i - 1).Value = wk
wk = Cells(3, i).Value: Cells(3, i).Value = Cells(3, i - 1).Value: Cells(3, i - 1).Value = wk
swap = True
End If
Next
Loop
Application.ScreenUpdating = True
End Sub

'2行目の値が3行目の値より小さい配列で、かつ、2行目の値が小さい順
Private Function change_test1(a2, a3, b2, b3) As Boolean
If b2 < b3 And (a2 >= a3 Or a2 < a3 And a2 > b2) Then
change_test1 = True
Else
change_test1 = False
End If
End Function

'3行目より、2行目の値の方が大きい配列を3行目の値が大きい順
Private Function change_test2(a2, a3, b2, b3) As Boolean
If b2 >= b3 And a2 >= a3 And a3 < b3 Then
change_test2 = True
Else
change_test2 = False
End If
End Function

補足

詳しい回答ありがとうございます。
もし、よろしければ、配列数が任意の値ｎのときで、sheet2に並び替えた配列を表示させるようにするにはどのようになるか教えていただけば幸いです。