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


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

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

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

回答の条件
  • 1人2回まで
  • 登録:2007/08/02 13:59:45
  • 終了:2007/08/02 23:10:20

ベストアンサー

id:momoko2004 No.1

momoko2004回答回数178ベストアンサー獲得回数22007/08/02 17:06:30

ポイント100pt

別途「処理結果」シートを作成し、結果を出力する形の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

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

id:WATANABE

エラーで400とでるのですが、何がいけないのでしょうか?結合も解除して貼り付けています。

2007/08/02 21:10:57

その他の回答(3件)

id:momoko2004 No.1

momoko2004回答回数178ベストアンサー獲得回数22007/08/02 17:06:30ここでベストアンサー

ポイント100pt

別途「処理結果」シートを作成し、結果を出力する形の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

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

id:WATANABE

エラーで400とでるのですが、何がいけないのでしょうか?結合も解除して貼り付けています。

2007/08/02 21:10:57
id:y3b5 No.2

y3b5回答回数32ベストアンサー獲得回数32007/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列が数値じゃなく文字だと有無しか判らないですが・・

id:WATANABE

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

2007/08/02 21:28:50
id:stingerwolf No.3

stingerwolf回答回数9ベストアンサー獲得回数12007/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

id:momoko2004 No.4

momoko2004回答回数178ベストアンサー獲得回数22007/08/02 22:09:46

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

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

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

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

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

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

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

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

id:WATANABE

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
  • id:momoko2004
    コメント欄開けていただきありがとうございます。

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

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

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

  • id:WATANABE
    ありがとうございました。希望通りの事ができました。感謝します。!
  • id:momoko2004
    これで今日は安心して寝られます。(^^;)

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

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

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

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

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

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

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません