締切済み

複数列の並び替え

2005/10/04 13:18

　　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　・・１　10　 8　25　30　40　２　11　53　３　21　28　32 ４　52　５　29 ・・上記の数値を並べ替え(昇順or降順)をするのに一度ではできないのでしょうか？ちなみにＢ以降をＡの下に貼り付けて並び替え以外の方法でお願いします。

4994
お礼率80% (33/41)

Windows NT・2000
回答数3
ありがとう数1

みんなの回答 （3）
専門家の回答

みんなの回答

mu2011
ベストアンサー率38% (1910/4994)

2005/10/04 13:49 回答No.3

多分、マクロだと一回で済むと思いますが、以下の方法は如何でしょうか。 (1)別シートA1セルに以下の関数を設定し、必要列分連続コピー =IF(ISERR(SMALL(Sheet1!A:A,ROW())),"",SMALL(Sheet1!A:A,ROW())) (2)範囲列を下方向にコピー (3)並び替え終了後、その範囲をコピーし、形式を選択して貼り付けの値のみで別エリアに貼り付けして下さい。因みに降順は、上記関数のsmallをlargeとします。

質問者

補足 2005/10/04 16:36

早速の回答ありがとうございます。さらに質問ですみません。下記のような数値の場合ではどうすればいいでしょうか？　　Ａ　　　　Ｂ　　　Ｃ　　　Ｄ　　　Ｅ　・・１　Ａ0010　Ａ0008　Ａ0025　Ａ0030　Ａ0040　２　Ａ0011　Ａ0053　３　Ａ0021　Ａ0028　Ａ0032 ４　Ａ0052　５　Ａ0029 ・　　・・　　・　　Ａ3025などの数値もあります

ログインすると、全ての回答が全文表示されます。

BLUEPIXY
ベストアンサー率50% (3003/5914)

2005/10/04 13:42 回答No.2

エクセル？行毎にソートする？列毎にソートする？矩形でソート？選択した矩形でソートの場合のマクロサンプル Public Sub sort() 'ソートモドキ Dim x As Range, i, wk Dim NumList, max Set NumList = CreateObject("Scripting.Dictionary") max = 0 '0以下の数字はない For Each x In Selection If Not NumList.Exists(x.Value) Then '重複チェック NumList.Add x.Value, x.Value If max < x.Value Then max = x.Value '空白は０扱い End If Next i = 1 Selection.ClearContents For Each x In Selection Do Until NumList.Exists(i) i = i + 1 If i > max Then Exit Sub Loop x.Value = NumList.Item(i) i = i + 1 Next End Sub Public Sub sort2() 'ソートモドキ Dim x As Range, i, wk Dim NumList, max Set NumList = CreateObject("Scripting.Dictionary") max = 0 '0以下の数字はない For Each x In Selection If Not NumList.Exists(x.Value) Then '重複チェック NumList.Add x.Value, 1 If max < x.Value Then max = x.Value '空白は０扱い Else '重複時の処理 NumList.Item(x.Value) = NumList.Item(x.Value) + 1 End If Next i = 1 Selection.ClearContents For Each x In Selection Do Until NumList.Exists(i) i = i + 1 If i > max Then Exit Sub Loop x.Value = i NumList.Item(x.Value) = NumList.Item(x.Value) - 1 If NumList.Item(x.Value) = 0 Then i = i + 1 End If Next End Sub ---------------------------------------------------------- sortは重複する項目を削除する sort2は重複する項目を削除しない

質問者