[Excel2000] データの移動について

質問

Ａ列～Ｆ列までの文字データを以下のようにＡ列とＢ列の２列に移動させたいのですが、いくら考えてもわかりません。データが1000件以上あり、手作業ではミスをしかねないので、何かよい方法はないでしょうか？よろしくお願いします。

（手順）
(1)Ｂ～Ｄ列のデータを縦に並べる。(Ｂ～Ｆには文字データが入ります。すべての列にデータがあるとは限りませんが、少なくとも、Ｂ列には必ずデータがあり、Ｂ、Ｃ、Ｄの順にデータが入っています。）
(2)その左側にＡ列のデータを並べる。

（Ａ列）　　　（Ｂ列）　（Ｃ列）　（Ｄ列）　（Ｅ列）　（Ｆ列）
000001 　　 10 　　　　 15 　　 20
000002　　　 5
000003 　　　15　　　　 10　　　 5　　 　3　　 　 1

↓

（Ａ列）　(Ｂ列）　
000001　 10
000001 　 15
000001 　 20
000002 　 5
000003 　15
000003　 10
000003　　 5
000003 　 3
000003 　　1

回答No.6

nishi6 · ベストアンサー

５列、１行を挿入して下のようにします。算式のみで行ってみます。

　(Ａ列)(Ｂ列)(Ｃ列)(Ｄ列)(Ｅ列)(Ｆ列)(Ｇ列)(Ｈ列)(Ｉ列)
１
２　　　　　　　　　　　　　　　000001___10____15____20
３　　　　　　　　　　　　　　　000002____5
４　　　　　　　　　　　　　　　000003___15____10_____5_____3____1

（１）A1に　1　を入力

（２）A2に　=A1+COUNT(G2:IV2)　を入力。Ｆ列のデータ数分Ａ列下方向にコピーします

（３）B2に　=MATCH(ROW()-1,$A$1:$A$4,1)+1　としてＢ列下方向にコピー
　　　　　　　　（※上の$A$4はＦ列が4行目までの例です）

（４）C2に　=COUNTIF($B$2:B2,B2)　　　　　 としてＣ列下方向にコピー

（５）D2に　=INDEX(F:F,B2)　　　　　　　　 としてＤ列下方向にコピー

（６）E2に　=OFFSET($F$1,B2-1,C2)　　　　　としてＥ列下方向にコピー

（７）D:E列をコピーして、どこかに形式を選択して貼り付け→値　を実行します。

お礼

nishi6さん、いつもありがとうございます。

おかげさまで100％問題を解決することができました。その他の作業を含め、昨日と今日の２日間で、所期の目的を果たすことができました。

作業をしながら、「このような難問に善意で、しかも完璧に答えて下さる方がいるとは」と涙が出そうになりました。

nishi6さんが教えて下さった関数がそれぞれどのような役割を果たすのか今は調べる余裕もありませんが、理解できるように努力したいと思います。

本当にありがとうございました。

回答No.8

papayuka

>#7さんへ

釈迦に説法かもしれませんが、行の操作は Integer でなく Long を使用した方が良いと思います。
この例では問題ないでしょうが、行数によってはオーバーフローします。

Sub Test()
Dim myCnt1 As Integer
Dim myCnt2 As Long
　Range("A32768").Value = 1
　myCnt2 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
　MsgBox "myCnt2 : " & myCnt2
　myCnt1 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
End Sub

お礼

回答ありがとうございました。

回答No.7

kazuhiko5681

こんばんわ。シート１にしかデータが入っていないという過程でサンプルマクロを作ってみました。次のように操作してみて下さい。

・データの入力されているブックを開き、ＡＬＴ＋Ｆ１１キーを押してＶＢＥ画面を表示させ、画面左上にVBAProjectと書かれているところにマウスポインターをあわせて右クリック後、挿入→標準モジュールを順にクリックして表示された右側の白い部分に下記のコードをコピーペーストする。

Sub Deta_Seiri()

Dim i As Integer
Dim j As Integer
Dim myCnt1 As Integer
Dim myCnt2 As Integer

myCnt1 = ThisWorkbook.Worksheets(1).Cells(Rows.Count, 1).End(xlUp).Row
myCnt2 = ThisWorkbook.Worksheets(1).Cells(1, 1).End(xlToRight).Column
For i = 2 To myCnt1
For j = 2 To myCnt2
If ThisWorkbook.Worksheets(1).Cells(i, j).Value <> "" Then
ThisWorkbook.Worksheets(1).Cells(Rows.Count, 7).End(xlUp).Offset(1, 0).Value = ThisWorkbook.Worksheets(1).Cells(i, 1).Value
ThisWorkbook.Worksheets(1).Cells(Rows.Count, 8).End(xlUp).Offset(1, 0).Value = ThisWorkbook.Worksheets(1).Cells(i, j).Value
End If
Next j
Next i

ThisWorkbook.Worksheets(1).Columns("A:F").Delete

End Sub

・ＡＬＴ＋Ｆ１１キーを再度押してエクセルの画面にもどり、メニューバーのツール→マクロ→マクロを順にクリックし、出てきたダイアログボックスの右側の実行ボタンをクリックする。

マクロが実行され、貴方様の思い通りの動作が確認できると思います。

ご不明な点・不具合がございましたら、ご遠慮なくなくお知らせ下さい。

お礼

kazuhiko5681さん、いつもありがとうございます。

試してみましたが、残念ながらエラーになってしまいました。
今回はnishi6さんの方法で解決しました。

回答ありがとうございました。

回答No.5

papayuka

こんにちは。

コピーブック等のテスト環境で試して下さい。（使用する場合は内容のチェックも）

シートを追加して転記します。

Sub Test()
Dim Ws As Worksheet, mSheet As Worksheet
Dim LRow As Long
　Set mSheet = ActiveSheet
　Set Ws = Worksheets.Add(after:=ActiveSheet)
　For i = 1 To mSheet.Cells(65536, 1).End(xlUp).Row
　　For j = 2 To mSheet.Cells(i, 1).End(xlToRight).Column
　　　LRow = Ws.Cells(65536, 1).End(xlUp).Row + 1
　　　Ws.Cells(LRow, 1) = mSheet.Cells(i, 1)
　　　Ws.Cells(LRow, 2) = mSheet.Cells(i, j)
　　Next j
　Next i
End Sub

お礼

papayukaさん、こんばんは。

返事が遅くなって申し訳ありません。

papayukaさんの作ってくださったマクロでバッチリでした。新しいシートに実行結果が出てくるなんてびっくりしてしまいました。（しかもすごい速さですね。）

ただ、空白のセルも移動してしまうのでその分の削除が必要でした。でも、すごいマクロなので大切に保存しておきたいと思います。

回答ありがとうございました。

回答No.4

kazuhiko5681

初めまして。貴方様のおやりになりたいことはマクロを組めば実にすばやく簡単に実行することができます。
もしよろしければ、コピー＆ペーストをするだけで貴方様の思い通りの動作をするサンプルマクロを組んでみたいと思います。
ご希望の節は、次のことを教えて下さい。
・データが入力されている最終の列番号

お手数をおかけいたします。よろしくお願いいたします。

回答No.3

tonyshoe

おっと失礼。とんちんかんな答えをしてしまいましたね。
takntさんの方法で良いでしょう。

お礼

回答ありがとうございました。

回答No.2

tonyshoe

コピーして貼り付けるときに、行列を入れ替えるを選択して貼り付けてください。
貼り付けのボタンの右にある▼で選択できます。

お礼

回答ありがとうございます。
No.6の方の回答により解決いたしました。

回答No.1

taknt

まず Ａ列を ＢとＣの間、 ＣとＤの間、ＤとＥの間、ＥとＦの間にコピーします。
それで コピーしたＡ列とＣ列をＡ列、Ｂ列の後ろにくっつけます。
同じように、ほかの ＡとＤ、ＡとＥ、ＡとＦをＡとＢの後ろに順にくっつけて、
Ｂ列でソートし、Ｂ列の何も入ってない行を削除してから、
Ａ列、Ｂ列でソートすればいいでしょう。

お礼

回答ありがとうございます。
No.6の方の回答により解決いたしました。