[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『離れた複数の列をまとめて並べ替えしたい』（しょうさん）
初めて質問させていただきます。
A B C D E 1 9 8 5 2 3 2 4 3 2 5 7
のような離れた列の数字を
A B C D E 1 9 5 3 2 8 5 2 3 7 4 2
と表全体で降順になるように並べ替えをしたいのですが何か方法はございますでしょうか。
よろしくお願いいたします。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
確認です。
・必ず１列おきに数字が入っているのですか？ ・列は E列までですか？ それとも、たまたま 例がそうであって、どこまであるか不明ですか？ ・行は 3 行 ですか？ それとも たまたま 例がそうであって、どこまであるか不明ですか？ ・並び替えた表ですが、列も 行も 元の表と同じ範囲にしたいのですね？
・で、これを関数で？ マクロでもいいのですか？
（β） 2017/02/02(木) 15:37
では実際に使っている表での範囲で説明させていただきます。
B14:B38,E14:E38,H14:H38,K14:K38
の範囲です。
上記の範囲は最大の範囲でして、例えばH20:H38,K14:38は空欄という場合もあります。
この辺は難しいようでしたら空欄ではなく代わりに0を入力する形でも大丈夫です。
並び変えた表は列も行も元の表と同じ範囲でしたいです。
マクロはやったことないのでできれば関数でお願いしたいのですが、難しいようでしたらマクロも挑戦してみようかと思います。
どうぞよろしくお願いいたします。
（しょうさん） 2017/02/02(木) 15:54
関数は不得意なので専門家さんからの回答をお待ちください。
場つなぎでマクロです。
元シートが SHeet1、並び替え後のイメージを Sheet2 に転記しています。
Sub Sample()
Dim al As Object
Dim r As Range
Dim c As Range
Dim v As Variant
Dim n As Variant
Dim x As Long
Dim i As Long
Dim j As Long
Set al = CreateObject("System.Collections.ArrayList")
With Sheets("Sheet1").Range("B14:K38")
ReDim v(1 To .Rows.Count, 1 To .Columns.Count)
For j = 1 To .Columns.Count Step 3
For i = 1 To .Rows.Count
n = .Cells(i, j).Value
If Not IsEmpty(n) Then al.Add n
Next
Next
End With
al.Sort
al.Reverse
i = 1
j = 1
For Each n In al.toarray
v(i, j) = n
i = i + 1
If i > UBound(v, 1) Then
i = 1
j = j + 3
End If
Next
With Sheets("Sheet2")
.Range("B14:K38").Value = v
.Select
End With
End Sub
（β） 2017/02/02(木) 16:16
指定の列だけ並び替えたい場合、まず列のカット＆ペーストで、対象列だけ隣り合った位置に移動させます。行の末尾に全てまとめるのが、後の作業が楽になります。
すべてまとめた後、範囲選択して並び替える。並び替え終わった後、元の列に戻す。末尾列にまとめたならば、列毎にコピー後、末尾列を削除するだけ。手間がかかりますが、マクロなしで解決できる方法です。
（???） 2017/02/02(木) 16:26
失礼します。
>>もし何もデータが入っていないだけならば、全選択して並び替えるだけ。
全領域の数字が降順に 左側の列から下に、さらに右に２列いって下に、さらに、・・・ ということなんだろうと思いますが、全領域選択で並び替えたときに、そういった形になるのでしょうか？
私が知らないだけで、何か指定方法を工夫すれば、そうなるのかなと興味がありまして。
私がやるとすれば 各列を どこか１列にコピペして、その列を並び替えたうえで、 元の領域に 列数分 コピペバック ということしか思い浮かびません。
（β） 2017/02/02(木) 16:32
???さま
指定以外の列には別のデータ（例えばB列には個数、C列には金額）が入力してあるため、並べ替えたくありません。
別の場所にコピーしてからっていうのは思いつきませんでした。
ありがとうございます。
（しょうさん） 2017/02/02(木) 16:42
私がおもいつきで （β） 2017/02/02(木) 16:32 でコメントした手順でコードを書いてみました。
これは、元の場所を置き換えています。もちろん、元の場所が Sheet1 で それを Sheet2 に並び替えて書きこむことも出きますが。
Sub Sample2()
Dim pos As Range
Dim from As Range
Application.ScreenUpdating = False
Columns("Z").Clear '作業列
Set pos = Range("Z1")
For Each from In Range("B14:B38,E14:E38,H14:H38,K14:K38").Areas
from.Copy pos
Set pos = pos.Offset(from.Cells.Count)
Next
Columns("Z").Sort key1:=Range("Z1"), Order1:=xlDescending, Header:=xlNo
Set from = Range("Z1")
For Each pos In Range("B14:B38,E14:E38,H14:H38,K14:K38").Areas
from.Resize(pos.Cells.Count).Copy pos
Set from = from.Offset(pos.Count)
Next
Columns("Z").Clear
End Sub （β） 2017/02/02(木) 16:51
別の場所でいいんだったら、かつ4列ぐらいなら
=IFERROR(LARGE(($B$14:$B$38,$E$14:$E$38,$H$14:$H$38,$K$14:$K$38),ROW(A1)),"")
こんな式でできると思いますけどね。
参考まで。 （笑） 2017/02/02(木) 16:59
元の表がSheet1にあり結果をSheet2に求める場合。
Sheet2のB14セルに =IFERROR(LARGE((Sheet1!$B$14:$B$38,Sheet1!$E$14:$E$38,Sheet1!$H$14:$H$38,Sheet1!$K$14:$K$38),ROW(A1)+(INT(COLUMN(A1)/3))*25),"") と入力してB38セルまでフィルコピー、その後B14:D38セルを選択してK列までフィルコピーではどうか。 （ねむねむ） 2017/02/02(木) 17:01
代わりに別案なぞ。 といっても、考え方はβさんとほぼ同じでした。 転記せず、元データをそのまま並び替えます。数値だけに対応しますので、文字が混じるようなら手直しが必要です。
Sub test()
Dim R As Range
Dim i As Long
With CreateObject("System.Collections.ArrayList")
Range("B14:B38,E14:E38,H14:H38,K14:K38").Select
For Each R In Selection
.Add R.Value
Next R
.Sort
.Reverse
For Each R In Selection
R.Value = .Item(i)
i = i + 1
Next R
End With
End Sub
（???） 2017/02/02(木) 17:13
笑さま
ねむねむさま
これでもいけそうでした。
ありがとうございました。
???さま
いえいえ
コピペ案は思いつきませんでした。
ありがとうございました。
（しょうさん） 2017/02/02(木) 17:21
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.