いつも御世話になっております。
今回はExcelを用いた初歩的な表計算で躓き投稿をさせて頂きました。
早速ですが、具体的な例を挙げます。
1 ------------------
2 A社 B社 C社
3 100 500 200
4 200 600 300
5 300 700 450
6 400 150 510
7 -----------------
この様に順不同で羅列された数字郡を
並べ替えたいのですが、この"縦列を崩さずに"並べ変えるには
どうすれば良いのでしょうか。
今までは列毎に色付けしてから
1列にまとめてデータ>並べ替えしてから手入力で列を復元させてました。
具体的にはこう言う感じにしたいのですが、、、
1 ------------------
2 A社 B社 C社
3 100
4 150
5 200 200
6 300 300
7 400
8 450
9 500
10 510
11 600
12 700
------------------
こんな感じで重複してれば同じ位置に、
複数の列を関連させて並べ替えさせたいのです。
このデータの処理が出来れば
使用ソフトはエクセルでなくても構いません。
聊か説明が解り難かったかも知れませんが、
補足要求や御助言頂ければ御願い致します。
No.6ベストアンサー
- 回答日時:
こんにちは。
VBAですと、こんなところでしょうかしらね。
昨日、できていたのですが、朝、見直しまし、オプションをつけました。
データは、A列から始まることは条件にしても、行の最初が決まっていないこと、タイトル行があるなしを想定しています。また、あたりまえのことですが、列の許す限りは、一応は、並べ替えはしてくれます。処理スピードも、そこそこに走ってくれます。
また、万が一、上書きや列が127行を超える予定がある場合は、ご相談ください。
'<標準モジュール>
Sub SortWithColumn()
'列付きの並び替え
Dim rng As Range, c As Range
Dim i As Long, k As Long, n As Long
Dim myTitle As Variant, myArray As Variant
Dim Rfirst As Long, Cfirst As Long, titleFlg As Byte
Dim myData As Double
Application.ScreenUpdating = False
'A列にデータがあれば、その範囲を取得
With Range("A65536").End(xlUp).CurrentRegion
'データの最初の行は?
Rfirst = .Cells(1, 1).Row
'タイトル行のチェック
If VarType(.Cells(1, 1)) = vbDouble Then
Rfirst = Rfirst - 1
titleFlg = 1 'タイトルなし
Else
myTitle = .Rows(1).Value 'タイトルは配列で取得
End If
'書き出しの列は、そのデータから2列離れた列
Cfirst = .Columns.Count + 2
'列の幅のチェック/もし、このメッセージが出たら、現行では終了
If Cfirst > 127 Then MsgBox "列が許容範囲を超えています。", 64: Exit Sub
Set rng = .Offset(1 - titleFlg).Resize(.Rows.Count - 1 + titleFlg)
End With
ReDim myArray(1, rng.Count - 1)
For Each c In rng
myArray(0, i) = c.Value
myArray(1, i) = c.Column
i = i + 1
Next c
'ソートプログラム
mySort myArray
'書き出しの最初の行,書き出しの最初の列
k = Rfirst: Cfirst = Cfirst
'タイトルの書き出し
If IsArray(myTitle) Then
Cells(k, Cfirst + 1).Resize(, rng.Columns.Count).Value _
= myTitle
End If
'
For n = LBound(myArray, 2) To UBound(myArray, 2)
If myData <> myArray(0, n) Then
k = k + 1
Cells(k, Cfirst + myArray(1, n)).Value = myArray(0, n)
Else
Cells(k, Cfirst + myArray(1, n)).Value = myArray(0, n)
End If
If n < UBound(myArray, 2) - 1 Then
myData = myArray(0, n)
End If
Next n
Application.ScreenUpdating = True
End Sub
Private Sub mySort(ar)
'2次元ソート
Dim u As Long
Dim i As Long
Dim j As Long
Dim t1 As Long, t2 As Long
u = UBound(ar, 2)
i = LBound(ar, 2)
Do While i < u
j = u
Do While j > i
If ar(0, j) < ar(0, i) Then '昇順
t1 = ar(0, j)
t2 = ar(1, j)
ar(0, j) = ar(0, i)
ar(1, j) = ar(1, i)
ar(0, i) = t1
ar(1, i) = t2
End If
j = j - 1
Loop
i = i + 1
Loop
End Sub
No.8
- 回答日時:
#6 のWendyです。
文章の訂正です。
×「また、万が一、上書きや列が127『行』を超える予定がある場合は、ご相談ください。」
○「また、万が一、上書きや列が127列を超える予定がある場合は、ご相談ください。」
つまり、上書きはしていないので、列の間を含めて、256の半分を超えてしまうと出力できなくなります。その場合は、シートを替えなくてはなりません。
No.7
- 回答日時:
仕事の帰り際に見て、気になって自宅でVBA組んで見ました。
>Excel2000での初歩表計算
すでに、同様の解答が出てますが、結構面倒ですね^^;
まあ、あんまりスマートではありませんが、質問で例にあげられていたパターンは依頼どおり設定できました。
Sub Macro1()
Dim intI As Integer
Dim intJ As Integer
Dim intK As Integer
Dim intL As Integer
Dim intMax As Integer
Dim MaxData As Integer
Dim FinF(3) As Integer
'A、B、C列をそれぞれソート
Range("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Range("B:B").Sort Key1:=Range("B1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
Range("C:C").Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
:=xlPinYin
'3列がすべて空白になるまで実行(要素数把握)
Do
intI = intI + 1
If Cells(intI, 1) = "" And _
Cells(intI, 2) = "" And _
Cells(intI, 2) = "" Then
'すべて初期値なら繰り返し処理終了
Exit Do
End If
Loop
'最大行数退避
intMax = intI - 1
ReDim intData(intMax, 3) As Integer
'要素をすべて退避
For intJ = 1 To intMax
intData(intJ, 1) = Cells(intJ, 1) 'A
intData(intJ, 2) = Cells(intJ, 2) 'B
intData(intJ, 3) = Cells(intJ, 3) 'C
Next intJ
'最大値+1を退避
If intData(intMax, 1) >= intData(intMax, 2) And _
intData(intMax, 1) >= intData(intMax, 2) Then
MaxData = intData(intMax, 1) + 1
ElseIf intData(intMax, 2) >= intData(intMax, 1) And _
intData(intMax, 2) >= intData(intMax, 3) Then
MaxData = intData(intMax, 2) + 1
Else
MaxData = intData(intMax, 3) + 1
End If
'初期値設定
intI = 1
intJ = 1
intK = 1
'各々のセルに設定
Do
intL = intL + 1
If intData(intI, 1) < intData(intJ, 2) And _
intData(intI, 1) < intData(intK, 3) Then
Cells(intL, 1) = intData(intI, 1)
Cells(intL, 2) = ""
Cells(intL, 3) = ""
intI = intI + 1
ElseIf intData(intJ, 2) < intData(intI, 1) And _
intData(intJ, 2) < intData(intK, 3) Then
Cells(intL, 1) = ""
Cells(intL, 2) = intData(intJ, 2)
Cells(intL, 3) = ""
intJ = intJ + 1
ElseIf intData(intK, 3) < intData(intI, 1) And _
intData(intK, 3) < intData(intJ, 2) Then
Cells(intL, 1) = ""
Cells(intL, 2) = ""
Cells(intL, 3) = intData(intK, 3)
intK = intK + 1
ElseIf intData(intI, 1) = intData(intJ, 2) And _
intData(intI, 1) < intData(intK, 3) Then
Cells(intL, 1) = intData(intI, 1)
Cells(intL, 2) = intData(intJ, 2)
Cells(intL, 3) = ""
intI = intI + 1
intJ = intJ + 1
ElseIf intData(intI, 1) = intData(intK, 3) And _
intData(intI, 1) < intData(intJ, 2) Then
Cells(intL, 1) = intData(intI, 1)
Cells(intL, 2) = ""
Cells(intL, 3) = intData(intK, 3)
intI = intI + 1
intK = intK + 1
ElseIf intData(intJ, 2) = intData(intK, 3) And _
intData(intJ, 2) < intData(intI, 1) Then
Cells(intL, 1) = ""
Cells(intL, 2) = intData(intJ, 2)
Cells(intL, 3) = intData(intK, 3)
intJ = intJ + 1
intK = intK + 1
Else
Cells(intL, 1) = intData(intI, 1)
Cells(intL, 2) = intData(intJ, 2)
Cells(intL, 3) = intData(intK, 3)
intI = intI + 1
intJ = intJ + 1
intK = intK + 1
End If
If intI > intMax Then
FinF(1) = 1
intI = intMax
intData(intI, 1) = MaxData
End If
If intJ > intMax Then
FinF(2) = 1
intJ = intMax
intData(intJ, 2) = MaxData
End If
If intK > intMax Then
FinF(3) = 1
intK = intMax
intData(intK, 3) = MaxData
End If
If FinF(1) = 1 And FinF(2) = 1 And FinF(3) = 1 Then
Exit Do
End If
Loop
End Sub
No.5
- 回答日時:
人に振って終わりだとあんまりなので、一応作ってみました。
全部VBAで作った方が、スピード的に有利だと思いますが、
参考URL#3の
mySmallというような順序づけを飛ばさない関数を使うと結構簡単です。
処理前のデータを残して
A8に
=IF(COUNTIF(A$3:A$6,mySmall($A$3:$C$6,ROWS(A$2:A2))),mySmall($A$3:$C$6,ROWS(A$2:A2)),"")
の式を入れて横に引っ張って縦に引っ張るとそういう形になります。
後は、できた部分をコピーして値で貼り付けで完成。
惜しむらくはとても遅いということですが、
どうせなら、全部VBAで作った方が早いと思いますが、
最近作った関数の再利用ということでやってみました。
参考URL:http://okweb.jp/kotaeru.php3?q=1478241
No.4
- 回答日時:
(1)関数でも相当難しい。
多分不可能。できるかどうかも未経験。(2)VBA(俗に言うマクロ)でもそのロジック(達成するためにどういう風に理屈を組み立てるか)も難しく、相当プログラムの経験をつんだ人から出そう。
私の思いついたのは、ヒントは
(1)3社(10社とか)の計数を全社込みで、会社列記号+計数のレコードを作り計数+会社列記号で昇順ソートする
(2)先頭から順に会社記号各列にセットしていく、同じ計数で数異記号は同行にセットする。行を進めない。
(3)同じ社で同じ値は下へ書き込む。書き込んだ数は覚える。各社の同じ値の最大行数を捕らえる。
(4)(3)の最大数+1行下から(2)を繰り返す。
何でそんな面倒なことをするのというレベルではこの問題は解けません。
もっとスッキリしたロジックがあれば教えていただきたいぐらいです。
上記でわかるように、これはVBAや関数の問題でなく、どう考えて手順を組み立てれば、すっきり処理できるかという問題の方が大事でかつ先行すべきものです。プログラムコーディングはそれほど難しいわけではないでしょう。
ですからエクセルVBAで十分です。
No.3
- 回答日時:
#1 のWendy02 です。
なるほどね。分かりました。#1の回答は、「没」にしてください。どうやら、VBAが必要のようですね。
ところで、以下のようになるのですね。
C社の部分が変です。本日は、遅いので、たぶん、明日にさせてください。
元のご質問は、ソースでも確認できましたが、こちらは、全角スペースを使っています。念のため。
1
2 A社 B社 C社
3 100
4 150
5 200 200
6 300 300
7 400
8 450
9 500
10 510
11 600
12 700
13
No.2
- 回答日時:
各列毎に、会社を区別した色をつけそのデータを縦に並べ替える(重複するデータはその横並び)という意味なら、VBAを使わずにはできません。
多分、Wendy02さんが作ってくれると思います。
No.1
- 回答日時:
こんにちは。
私は、関数は不得意なのですが、「初歩的な表計算」とは思えません。
E2:~
=IF(COUNT($A$2:$C$5)<=COUNT($E$1:F1),"",SMALL($A$2:$C$5,COUNT($E$1:F1)+1))
F2:~
=IF(COUNTIF($A$2:$C$5,E2)<2,"",E2)
もし、三つあれば、
E2:~
=IF(COUNT($A$2:$C$5)<=COUNT($E$1:G1),"",SMALL($A$2:$C$5,COUNT($E$1:G1)+1))
F2:~
=IF(COUNTIF($A$2:$C$5,E2)<2,"",E2)
G2:~
=IF(COUNTIF($A$2:$C$5,E2)<3,"",E2)
となりますね。
もし、VBAでもよいのでしたら、そちらも考えてみたいと思います。
>並べ替えたいのですが、この"縦列を崩さずに"並べ変えるにはどうすれば良いのでしょうか。
ということは、Excelの並び替え機能は使わずに作ることになると思います。
この回答への補足
助言頂き有難うございます。
質問での図がスペースで潰れてしまってたので、
改めて入れますと、
1-------------------
2-A社--B社--C社
3-100----------
4------150-----
5-200--200-----
6-300--300-----
7-400----------
8-----------450
9------500-----
10----------510
11-----600-----
12-----700-----
13------------------
こんな感じになります、、
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) Excelで、行に複数の数字が入力されているセルが複数の列存在し、行を跨いでセル内の数値を並び替える 5 2022/06/17 18:03
- Visual Basic(VBA) 指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける 3 2022/09/10 07:55
- Excel(エクセル) Googleスプレッドシートの割合の関数と円グラフの並べ替えについて 1 2022/07/22 17:31
- Excel(エクセル) Excel 郵便番号順に並び変えたい 同じ番号が複数あるとき 4 2022/04/28 18:35
- Excel(エクセル) 結合セルのソートについて 5 2022/04/22 11:57
- Visual Basic(VBA) Excelで横書き50行の漢字テストデータを縦書きのテスト問題にしたい。 6 2022/04/27 15:03
- Excel(エクセル) エクセルでのマクロを使ったデータの並べ替え 3 2022/12/03 18:54
- Visual Basic(VBA) 指定月分の顧客データファイルを統合して並べ替え、所定の場所に貼り付ける (再質問) 4 2022/09/14 22:51
- Excel(エクセル) Excelの計算式で質問です。 3 2022/06/21 21:58
- その他(IT・Webサービス) 高速処理可能な表計算ソフトについて ExcelやGoogleスプレッドシートのような表計算ソフトで、 2 2023/04/29 16:06
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
別シートからの文字を変更
-
エクセルの行の抽出について質...
-
Excel 2019 のピボットテーブル...
-
Excelのセルを飛ばして入力する
-
【マクロ】エクセルにかいてあ...
-
Excelのオートフィル
-
Excel初心者です。 詳しい方、...
-
スプレッドシート クエリ関数 1...
-
MOS365 Excel Expert / Excel R...
-
西暦や和暦の表示をyyyymmdd表...
-
Excel初心者です。 詳しい方、...
-
excelの不要な行の削除ができな...
-
エクセルの数式で教えてください。
-
スプレッドシートの関数VLOOKUP...
-
エクセルでセルに「氏名を入力...
-
エクセルで指定した日付、店舗...
-
【Excel】セル内の時間帯が特定...
-
Excelのグラフ軸について
-
Excel 2019 は、SPILL機能があ...
-
関数を教えて下さい。
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ファイル内にある数字の出現回...
-
Excel関数の先頭に「@」が入っ...
-
エクセルの気味悪い不思議
-
Excel VBAで、実行時にsheet上...
-
表示されている人数だけを数え...
-
他人が作ったマクロの理解
-
Excelの関数について質問です。
-
Excel 集計表
-
エクセル 日時の計算式について
-
Excelの関数に関して質問です。...
-
エクセル:セル内の文字列の下...
-
絞り込み検索
-
エクセルの関数で
-
エクセルの書式設定について教...
-
余分なEXCELファイルに印刷され...
-
VBA 同一シート内での転記の仕方
-
長期休みの関数はありますか
-
Excelの空のセル
-
エクセルで入力してある文を別...
-
Excelのマクロで、セルを結合し...
おすすめ情報