エクセルについての質問です。

Question

WATANABE

24

21もっと見る

100pt

コンピュータ

エクセルについての質問です。

A列、複数行（3から5行程度）が結合されたセルでタイトルデータ、B列の各行は詳細が入力されています。

これをA列のセルを結合を解除、B列の詳細データは、それぞれB列、C列、D列、・・・というように一行にしたいと考えています。

手作業で無く効率よくこなせる方法を教えて下さい。

回答の条件

1人2回まで

登録：2007/08/02 13:59:45
終了：2007/08/02 23:10:20

※ 有料アンケート・ポイント付き質問機能は2023年2月28日に終了しました。

No.2

y3b53232007/08/02 15:32:45

(1)A列のセル結合を解除

(2)A列が空いているセルを埋める

  例：
  AAA   1
  AAA   2
  AAA   3
  ・・・
  CCC   5

(3)タイトルをつける

  例：
  名前  数値
  AAA   1
  AAA   2

(4)ピボットテーブルを作成

  行のフィールド：名前
  列のフィールド：数値
  データアイテム：数値の合計

とすると

http://q.hatena.ne.jp/images/question/1186030/1186030784.jpg

と同じ並びはできましたが、いかがでしょうか？

なお、B列が数値じゃなく文字だと有無しか判らないですが・・

サンプル画像と違って、実際には、B列は数値では無いので、上記では出来ませんでした。

2007/08/02 21:28:50

No.3

stingerwolf912007/08/02 15:56:48

関数でやってみます。

念のため、作業シートを一枚作ってやってみてください。

元データのAB列をコピーして、作業用シートのCD列に貼り付けます。
A1=C1、A2=IF(C2="",A1,C2)と入力して、A2をコピーし、該当行まで貼り付けます。
B1=A1&COUNTIF(A$1:A1,A1)と入力してB1をコピーし、該当行まで貼り付けます。

こんな表になります。

A	B	C	D
AAA	AAA1		1
AAA	AAA2	AAA	2
AAA	AAA3		3
BBB	BBB1		1
BBB	BBB2		2
BBB	BBB3	BBB	3
BBB	BBB4		4
BBB	BBB5		5
CCC	CCC1		1
CCC	CCC2	CCC	2
CCC	CCC3		3
CCC	CCC4		4

E1=IF(ISERROR(VLOOKUP($A1&COLUMN()-4,$B:$D,3,0)),"",VLOOKUP($A1&COLUMN()-4,$B:$D,3,0))と入力して、E1を必要な列、行までコピーして貼り付けます。
データ範囲を全て選択してコピーし、右クリック「形式を選択して貼り付け」で「値」にしてOKします。
BCD列を削除します。
「データ」→「フィルタ」→「フィルタオプションの設定」をクリックし、データ範囲をがリスト範囲に設定されていることを確認してから「重複するレコードは無視する」にチェックを入れてOKします。
すると1行目を除いて例示の表が表示されるので、必要であれば1行目を除いた表示データをコピーして、所定の場所に貼り付けます。

以上ご参考まで。

http://www.eurus.dti.ne.jp/~yoneyama/Excel/jituyou/calendar.htm

No.4

momoko200417822007/08/02 22:09:46

申し訳ありません。マクロ作成時に作った大元のファイルは問題なく動くのですが、なぜか貼り付けたテキストをコピーしてステップで動かしたとき、以下で引っかかりました。(でもエラーコードは1004です。)

// ' 作業用シートで、A列のセル結合をすべて解除

// Columns("A:A").Select

この、"Columns("A:A").Select"を以下に書き換えてみてください。

Worksheets("作業用").Columns(1).Select

エラーコードが違うのが気になりますが、お手数ですが、ステップ(F8を押すと1ラインずつコマンドを実行してくれます)実行していただくとひっかかる箇所が特定できるので、回答がつけやすいです。

これが最後の回答になるので、もしまだ問題が出るようであれば、トラックバックかコメントで対応させていただきます。

ところで、結合はマクロの中で解除していますので、当初例示いただいた形のデータ形式で動くはずです。(ちょうど今回修正を加える部分が結合解除してる箇所です。)

Sub Macro1()

Dim WB_C As Integer '処理シートの行・列カウンタ

Dim RT_C, RT_R As Integer '結果シートの行・列カウンタ

Dim WB1 As String '処理シート名

WB1 = ActiveSheet.Name

ActiveWorkbook.Worksheets.Add.Name = "処理結果"

ActiveWorkbook.Worksheets.Add.Name = "作業用"

' シートを全コピー

Sheets(WB1).Select

Cells.Select

Selection.Copy

Sheets("作業用").Select

ActiveSheet.Paste

' 作業用シートで、A列のセル結合をすべて解除

Worksheets("作業用").Columns(1).Select

Selection.UnMerge

WB_C = 1

RT_R = 1 '処理結果ワークシートの行コントロール

RT_C = 1 '処理結果ワークシートの列コントロール

Do Until (Cells(WB_C, 2) = "")

CellA = Cells(WB_C, 1)

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 1)

RT_R = RT_R + 1

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

RT_R = RT_R + 1

WB_C = WB_C + 1

Do While (Cells(WB_C, 1) = "")

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

WB_C = WB_C + 1

RT_R = RT_R + 1

If Cells(WB_C, 2) = "" Then GoTo EOJ

Loop

RT_C = RT_C + 1

RT_R = 1

Loop

EOJ:

Worksheets("作業用").Delete

End Sub

で実行、”ActiveWorkbook.Worksheets.Add.Name = "処理結果"”のあとF8を入力するとストップします。エラー1004

よろしくお願いします。

2007/08/02 22:33:11

momoko2004 2007/08/02 22:42:41

コメント欄開けていただきありがとうございます。

”ActiveWorkbook.Worksheets.Add.Name = "処理結果"”

このステートメントは、"処理結果"という名前で新たにワークブックにシートを追加するため、既に同名のシートが存在するとエラーコード1004が出ます。

このマクロを同じファイルに対して二度・三度と実行する場合、お手数ですが、「処理結果」や「作業用」というワークシートを削除してから実行してみてください。
WATANABE 2007/08/02 23:09:12

ありがとうございました。希望通りの事ができました。感謝します。！
momoko2004 2007/08/02 23:22:20

これで今日は安心して寝られます。(^^;)

蛇足ながら、カウンタ類すべてinteger形で宣言してしまっているので、処理するシートのデータ量が多くて行または列が256を超える場合は、Longとかにしないとオーバーフローします。

下のステートメントでIntegerをLongに変えた場合、10000000までカウントできます。

// Dim WB_C As Integer '処理シートの行・列カウンタ
// Dim RT_C, RT_R As Integer '結果シートの行・列カウンタ

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

リクエスト送信済

回答リクエストを送信したユーザーはいません

momoko2004 · Accepted Answer · 2007-08-02T17:06:30+09:00

別途「処理結果」シートを作成し、結果を出力する形のEXCELマクロです。貼り付けると行頭スペースがとれて読みにくいですが、そのままSubからEnd Subまでをコピーしていただければ動きます。

結合セルの取り扱いが面倒なので、作業用シートにデータコピーし、結合解除して処理しています。

二列目のセルが空になったところでデータが終わったとみなし、作業用シートを削除して終了します。

----------------

Sub Macro1()

Dim WB_C As Integer '処理シートの行・列カウンタ

Dim RT_C, RT_R As Integer '結果シートの行・列カウンタ

Dim WB1 As String '処理シート名

WB1 = ActiveSheet.Name

ActiveWorkbook.Worksheets.Add.Name = "処理結果"

ActiveWorkbook.Worksheets.Add.Name = "作業用"

' シートを全コピー

Sheets(WB1).Select

Cells.Select

Selection.Copy

Sheets("作業用").Select

ActiveSheet.Paste

' 作業用シートで、A列のセル結合をすべて解除

Columns("A:A").Select

Selection.UnMerge

WB_C = 1

RT_R = 1 '処理結果ワークシートの行コントロール

RT_C = 1 '処理結果ワークシートの列コントロール

Do Until (Cells(WB_C, 2) = "")

CellA = Cells(WB_C, 1)

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 1)

RT_R = RT_R + 1

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

RT_R = RT_R + 1

WB_C = WB_C + 1

Do While (Cells(WB_C, 1) = "")

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

WB_C = WB_C + 1

RT_R = RT_R + 1

If Cells(WB_C, 2) = "" Then GoTo EOJ

Loop

RT_C = RT_C + 1

RT_R = 1

Loop

EOJ:

Worksheets("作業用").Delete

End Sub

----------------

momoko2004 · Accepted Answer · 2007-08-02T17:06:30+09:00

別途「処理結果」シートを作成し、結果を出力する形のEXCELマクロです。貼り付けると行頭スペースがとれて読みにくいですが、そのままSubからEnd Subまでをコピーしていただければ動きます。

結合セルの取り扱いが面倒なので、作業用シートにデータコピーし、結合解除して処理しています。

二列目のセルが空になったところでデータが終わったとみなし、作業用シートを削除して終了します。

----------------

Sub Macro1()

Dim WB_C As Integer '処理シートの行・列カウンタ

Dim RT_C, RT_R As Integer '結果シートの行・列カウンタ

Dim WB1 As String '処理シート名

WB1 = ActiveSheet.Name

ActiveWorkbook.Worksheets.Add.Name = "処理結果"

ActiveWorkbook.Worksheets.Add.Name = "作業用"

' シートを全コピー

Sheets(WB1).Select

Cells.Select

Selection.Copy

Sheets("作業用").Select

ActiveSheet.Paste

' 作業用シートで、A列のセル結合をすべて解除

Columns("A:A").Select

Selection.UnMerge

WB_C = 1

RT_R = 1 '処理結果ワークシートの行コントロール

RT_C = 1 '処理結果ワークシートの列コントロール

Do Until (Cells(WB_C, 2) = "")

CellA = Cells(WB_C, 1)

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 1)

RT_R = RT_R + 1

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

RT_R = RT_R + 1

WB_C = WB_C + 1

Do While (Cells(WB_C, 1) = "")

Worksheets("処理結果").Cells(RT_C, RT_R) = Worksheets("作業用").Cells(WB_C, 2)

WB_C = WB_C + 1

RT_R = RT_R + 1

If Cells(WB_C, 2) = "" Then GoTo EOJ

Loop

RT_C = RT_C + 1

RT_R = 1

Loop

EOJ:

Worksheets("作業用").Delete

End Sub

----------------

エクセルについての質問です。

ベストアンサー

momoko200417822007/08/02 17:06:30

その他の回答（3件）

momoko200417822007/08/02 17:06:30ここでベストアンサー

y3b53232007/08/02 15:32:45

stingerwolf912007/08/02 15:56:48

momoko200417822007/08/02 22:09:46

コメント（3件)

この質問への反応（ブックマークコメント）