Excelマクロ 表の書き換え方法教えてください

質問

2日くらいあれこれやってみたのですが、全くできないためお教えいただけますでしょうか。

1 2 3 4 5 6 7
A a b c d e f g
B h i j k l m n
C o p q r s t
D u v w x y z
（以下続く）
注）A1セルは空白、1、a、h、o、uは同じ列になります

という表（Book1.xls）を下記（Book2.xls）へ変更するマクロを作りたいと思っています。

A 1 a
A 2 b
A 3 c
A 4 d
A 5 e
A 6 f
A 7 g
B 1 a
B 2 b
（以下略）

Book1の行数は任意、1～7は固定、abcde…は空白セルもあります。

いいマクロがありましたらぜひご教授ください。
よろしくお願い致します。

回答No.3

Wendy02 · ベストアンサー

こんにちは。

>いいマクロがありましたらぜひご教授ください。

いいマクロとは言いませんが、こんに風にしたらいかがでしょうか？
コメントブロックしたところをはずせば、行の右端のところがブランクの場合は、無視されます。シート1 のA1は空白でも、A1の隣のセルからデータが始まっていれば、データは、自動的に取れます。

Sub ReplacingLocation()
Dim c As Variant
Dim rng As Range
Dim rngData As Range
Dim i As Long
Set rng = Worksheets("Sheet1").Range("A1").CurrentRegion
With rng
　Set rngData = .Offset(1, 1).Resize(.Rows.Count - 1, .Columns.Count - 1)
End With
i = 1
For Each c In rngData
　'If c.Column <= rngData.Cells(rngData.Count).Column And c.Value <> "" Then
　With Worksheets("Sheet2")
　　 .Cells(i, 1).Value = rng.Cells(c.Row, 1).Value
　　 .Cells(i, 2).Value = rng.Cells(1, c.Column).Value
　　 .Cells(i, 3).Value = c.Value
　End With
　i = i + 1
　'End If
Next
Set rngData = Nothing: Set rng = Nothing
End Sub

お礼

ありがとうございました。
表がきれいにできました！

同じことをするにも色々な組み方があって面白いなと思いました。

私もマクロについて基礎からきちんと勉強しなおします。

回答No.4

imogasi

問題にミスタイプがありませんか？
B 1 a
B 2 b
は
B 1 h
B 2 i
でしょう。
＞A1セルは空白
この意味は？
ーーー
下記でどうですか。
例　　A1:H4
A a b c d e f g
B h i j k l m n
C o p q&nbsp; r s t uu
D u v&nbsp; w x y z zz
コード
Sub test01()
Dim sh1 As Worksheet
Dim sh2 As Worksheet
'--
Set sh1 = Worksheets("Sheet1")
Set sh2 = Worksheets("Sheet2")
'---
k = 1
For i = 1 To 4
For j = 2 To 8
sh2.Cells(k, "A") = sh1.Cells(i, "A") & j - 1 & sh1.Cells(i, j)
k = k + 1
Next j
Next i
End Sub
結果
A1a
A2b
A3c
A4d
A5e
A6f
A7g
B1h
B2i
B3j
B4k
B5l
B6m
B7n
C1o
以下略
＞マクロがありましたらぜひご教授ください
マクロ（プログラム）は、既にあるものを、どこかから、見つけるのでなく、自分で作り出すものです。

お礼

仰る通り、ミスタイプがございました。申し訳ございません。
A1は空白、と書きましたのは
質問を書いているときに空白を入れても、確認画面になると空白が無視されてしまいAの上に1があるかのような表になってしまいましたので
誤解を招いてしまうかと思い、書いたものです。

マクロは自分で作り出すもの、仰る通りです。
私もまだまだ修行が足りません・・・

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

回答No.2

mshr1962

Sub Macro1()
Dim RG As RAnge
Set RG = Workbooks("BOOK1.xls").Sheets("Sheet1").Range("A1")
For Lx = 1 to 4　'←実際の行数をセットしてください。
For Cx = 1 to 7
Y = Y + 1
Cells(Y,1) = RG.Offset(Lx,0)
Cells(Y,2) = RG.Offset(0,Cx)
Cells(Y,3) = RG.Offset(Lx,Cx)
Next Cx
Next Lx
End Sub

こんなとこでしょうか？
※Book2上にマクロを設定して、実行してください。
Cの行の7の列はブランクなので　Ｃ 7 _ ("_"はブランクの意味)になりますが...

お礼

ありがとうございました。
やってみたら一瞬でできました。感動です。。。
自分であれこれマクロを組んでいたときは、やたら長いものになっていたのですが
こんなに少ない量のマクロでできてしまうものなのですね。

回答No.1

zap35

BOOK2のB1、B2は"h","i"ではなく"a","b"ですか？

単純に横に並んでいる並びを、縦並びに変えたいのならマクロの記録機能を利用して
　「Book1のデータ先頭を選択」
　「Shift+Ctrl＋*」　→　表範囲を全選択
　「選択範囲をコピー」
　「BOOK2の貼り付け位置を選択」
　「編集」→「形式を選択して貼り付け」
　「行列を入れ替えるにチェック」→「OK」
をマクロにしてみてください。

もし意味が違うなら補足お願いします

お礼

すみません、記載ミスをしておりました。
B1、B2は　"h" "i" です。
（#4の方が仰っている通りです）
単純に行列の入れ換えですと、やたら横に長い表ができるだけで手作業になってしまいましたし
同じような表は今後ずっと変換する必要がありましたので、マクロを組もうかと考えました。