《エクセル2000》こんな並べ替えはできますか

質問

こんにちは。
各セルに、このような感じで文字列が入っています。

野菜　　大根　人参　　タマネギ　ゴボウ
調味料　塩　　砂糖　
道具　　包丁　まな板　菜箸

これを、一番左はじの列のカテゴリ（？）ごとに、このように細目を縦一列に並べ替えたいのです。

野菜　　大根
　　　　人参
　　　　タマネギ
　　　　ゴボウ
調味料　塩
　　　　砂糖
道具　　包丁
　　　　まな板
　　　　菜箸

大根、人参に相当する細目の数はランダムです。
一括で並べ替える方法はあるでしょうか。
情報お待ちしています。

回答No.3

maruru01 · ベストアンサー

こんにちは。maruru01です。

元のデータが[Sheet1]にあり、A列にカテゴリでB列～に細目があるとします。
これを[Sheet2]のA列（カテゴリ）とB列（細目）に並べ替えます。

Sub 並べ替え()

　　Dim ST1 As Worksheet
　　Dim ST2 As Worksheet
　　Dim LastRow1 As Long
　　Dim Col1 As Long
　　Dim Row2 As Long
　　Dim i As Long
　　Dim temp As String

　　Set ST1 = Worksheets("Sheet1")
　　Set ST2 = Worksheets("Sheet2")

　　LastRow1 = ST1.Range("A65536").End(xlUp).Row
　　Row2 = 1

　　For i = 1 To LastRow1
　　　　Col1 = 2
　　　　temp = ST1.Cells(i, 1).Value
　　　　If Len(temp) > 0 Then
　　　　　　ST2.Cells(Row2, 1).Value = temp
　　　　　　temp = ST1.Cells(i, Col1).Value
　　　　　　Do While Len(temp) > 0
　　　　　　　　ST2.Cells(Row2, 2).Value = temp
　　　　　　　　Row2 = Row2 + 1
　　　　　　　　Col1 = Col1 + 1
　　　　　　　　temp = ST1.Cells(i, Col1).Value
　　　　　　Loop
　　　　End If
　　Next i

　　Set ST2 = Nothing
　　Set ST1 = Nothing

　　MsgBox "終了"

End Sub

行列位置については、上手く応用して下さい。

お礼

…できました！
いつもいつも、本当にありがとうございます。

回答No.6

moon_piyo

こんちは。補助列を使ってよければこんな方法もあります

元データの範囲
カテゴリ: Sheet1!A1:A999
細目: Sheet1!B1:O999

[1] Sheet2の下記のセルに式を入力します
A1: =IF(AND(COUNTA(Sheet1!$B$1:$O$999)>ROW()-ROW(A$1),E1=1),INDEX(Sheet1!$A$1:$A$999,D1),"")
B1: =IF(COUNTA(Sheet1!$B$1:$O$999)>ROW()-ROW(B$1),INDEX(Sheet1!$B$1:$O$999,D1,E1),"")
C1: 0
C2: =COUNTA(Sheet1!$B$1:O1)
D1: =MATCH(ROW()-ROW(D$1),C$1:C1)
E1: =COUNTIF(D$1:D1,D1)

[2] A1:B1, C2, D1:E1をそれぞれ下方コピー

お礼

VBAを使わない方法なのですね。
VBAはちょっと、という方にいいですね。
どうもありがとうございました。

回答No.5

taocat

こんにちは。

Sheet1：Ａ列カテゴリ　Ｂ列以降項目
これを、Sheet2　へ質問のように変換
それぞれ一行目からデータがあるとする

-------------------------------------------------
Sub test()
　Dim C As Integer
　Dim R As Long
　Dim NewRow As Long
　Dim Sht2 As Worksheet

　Worksheets("Sheet1").Activate
　Set Sht2 = Worksheets("Sheet2")
　Sht2.Cells.ClearContents

　For R = 1 To Range("A65536").End(xlUp).Row
　　　Sht2.Cells(NewRow + 1, 1).Value = Cells(R, 1).Value
　　　For C = 2 To Cells(R, "IV").End(xlToLeft).Column
　　　　　NewRow = NewRow + 1
　　　　　Sht2.Cells(NewRow, 2).Value = Cells(R, C).Value
　　　Next C
　Next R

End Sub
-----------------------------------------------

以上です。

お礼

お陰様で解決致しました。ありがとうございました。
目下VBA勉強中なもので、早く皆さんのようになりたいです…

回答No.4

Wendy02

面白いですね。ちょうど、この前、私が回答したご質問の逆なのですね。（^^;
このマクロは、上書きしてしまいますので、万が一には、別のシートにコピーしておいてください。

画面下のシート[タブ]を右クリックして、「コードの表示」で、以下を貼り付けて、ツール－マクロ－マクロで、「シート名!Test_JaggedArray」を選んでください
もちろん、標準モジュールに登録してもかまいません。

Sub Test_JaggedArray()
Dim ac As Long, ar As Long
Dim i As Long, j As Long
Dim r As Range
　Dim JagArray() As Variant
　'データの左上隅をA1 としています。
　Set r = Range("A1").CurrentRegion
　ac = r.Columns.Count
　ar = r.CurrentRegion.Rows.Count
　ReDim JagArray(1 To ar, 1 To ac)
　Application.ScreenUpdating = False
　For i = 1 To ar
　　For j = 1 To ac
　　　JagArray(i, j) = Cells(i, j).Value
　　Next j
　Next i
　　r.CurrentRegion.ClearContents
　　'元のデータを消します。
　k = 1
　For i = LBound(JagArray, 1) To UBound(JagArray, 1)
　　Cells(k, 1).Value = JagArray(i, 1)
　　For j = LBound(JagArray, 2) + 1 To UBound(JagArray, 2)
　　　If JagArray(i, j) <> Empty Then
　　　　Cells(k, 2).Value = JagArray(i, j)
　　　　k = k + 1
　　　End If
　　Next j
　Next i
　Set r = Nothing
　Application.ScreenUpdating = True
End Sub

お礼

いつもいつもお世話になっております(^_^;)
お陰様で解決しました。ありがとうございました。

回答No.2

koganeton

単純にマクロで上から順に
違うシートにでも
表示させればいいと思いますけど。

お礼

すみません、「上から順に違うシートに表示」とはどういった形になるのでしょうか。
お手数ですが、補足をお願いできますか。

回答No.1

Kamako55

これで参考になればいいのですが

野菜、調味料、道具などの項目の列は
例えば、Aの列に作るとします（これでOKですか？）

【野菜】の細目を並べ替える場合
大根（B2セル）、人参（C2セル）～ゴボウ（E2セル）に入力されている
B2セル～E2セルまでをドラッグしてコピーする

そして、縦に貼り付けたい最初のセル（例えばB3）にマウスを合わせる
右クリック＞貼り付けの『形式を選択して貼り付け』を選択
右下にある『行列を入れ替える』の項目にチェックを入れて『OK』

これで、横に羅列されているものを縦に羅列できると思います。（逆に縦から横も出来ます）

説明が上手くできなくてスミマセン(>_<)
これで回答になっているといいのですが、やってみてください！

お礼

この方法は私も考えたのですが「野菜」や「調味料」にあたるカテゴリは数百あり、できればその数百あるものを、一気に並べ替えたいのです。
細目の数が全て同じなら、マクロか何かで簡単に作れそうな気がするのですが、2～15くらいのランダムなもので、頭を抱えています。

ご回答ありがとうございました。
引き続き、情報お待ちしています。