Excel(VBA)マトリクスの解体方法について

質問

VBAで、以下のようなマクロを作成したいのですが、どのように作成したら良いのか検討がつきません。
どのようにすれば良いか、ご教授いただけたらと思います。
(過去の質問No.1488981を参考に記入させていただきます)

(1)下記のように、縦横のマトリクス表にデータが入力されている。

　　　　A　B　C ・・
1　　　X　Y　Z
2　a　○　×　○
3　b　×　○　○
4　c　○　○　○

(2)これを別シートに【"○"のついたデータのみ】縦に３列にデータを並べるように処理する。
　左列には"項番"(1～)、中列には"行データ"、右列には"列データ"

1　a　X
2　a　Z
3　b　Y
4　b　Z
　・
　・
　・

(3)列データと行データの数は不定で、一番右下となるセルまで、処理を繰り返すかたちにする。(空白セルが10個以上になる等の条件で)

以上のような条件です。ご回答よろしくお願い致します。

回答No.3

imogasi · ベストアンサー

（データ例）A2:D5
A　　　　B C　　　　D列　＜－－－データではない
X Y Z　　＜－－－第２行
a ○ × ○
b × ○ ○
c ○ ○ ○
Sub test07()
k = 1 '書き出すスタート行
d = Range("A65536").End(xlUp).Row '最下行
For i = 2 To d
For j = 2 To 4 'B-Dの3 列
If Cells(i, j) = "○" Then
Cells(k, "G") = Cells(i, "A") 'その行のA列の文字列
Cells(k, "H") = Cells(2, j) '第２行目にある見出し
k = k + 1 '次は１行下へ書き出す
End If
Next j
Next i
End Sub
こんなに簡単。
（結果）G1:H７
a X
a Z
b Y
b Z
c X
c Y
c Z
別シートにする場合はCellsの前に限定が必要。具体的には略。

お礼

ほとんどそのままを使用させていただきました。
初心者の私にもわかりやすいマクロでした。
ありがとうございます。

回答No.4

Wendy02

こんにちは。
#1さんの
＞いきなり答えを書いてしまうと勉強にならないと思うので、

ここの質問の要求の度合いにもよりますが、私のが正答とも限りません。正答でなければ、ヒントにもなりませんし、書かないと分らないものがありますからね。（^^;

ただ、

＞1　a　X
＞2　a　Z
というデータの取り方だから、以下は成り立つわけで、そうでなかったら、私のは成り立ちません。

Sub TestSample()
Dim Rng As Range
Dim Sh2 As Worksheet
Dim c As Range, i As Long
Dim fRow As Integer
Dim fCol As Integer

'左上端のセルを先頭に置く
Set Rng = Range("A1").CurrentRegion
Set Sh2 = Sheet2

　fRow = Rng.Row
　fCol = Rng.Column
With Sh2
For Each c In Rng
　If c.Value = "○" Then
　　i = i + 1
　　.Cells(i, 1).Value = i
　　.Cells(i, 2).Value = Rng.Cells(c.Row - fRow + 1, 1).Value
　　.Cells(i, 3).Value = Rng.Cells(1, c.Column - fCol + 1).Value
　End If
Next c
End With
　Set Sh2= Nothing
　Set Rng = Nothing
End Sub

お礼

質問の内容がわかりにくくて申し訳ありませんでした。
ですが、ご回答いただいたマクロを実行したところ、当方の望んでいた動作となりました。
今回はNo.3でいただいたマクロを使用させていただきましたが、こちらの回答もとても参考になりました。
ご回答ありがとうございました。

回答No.2

BLUEPIXY

○×の入っている範囲を選択してからマクロ実行
--------------------------------------------
Public Sub Sample()
Dim r As Range, out As Range
Dim x, y, c
Set r = Selection
Set out = Range("Sheet2!A1")
c = 0
For y = 1 To r.Rows.Count
For x = 1 To r.Columns.Count
If r.Cells(y, x).Value = "○" Then
out.Offset(c, 0).Value = c + 1
out.Offset(c, 1).Value = r.Cells(y, 0).Value
out.Offset(c, 2).Value = r.Cells(0, x).Value
c = c + 1
End If
Next
Next
End Sub

お礼

すみません。当方の知識不足のため、こちらのマクロを使用することができませんでしたので、No.3の回答の方を参考にさせていただきました。

いただいたマクロも理解できるように勉強したいと思います。
ご回答ありがとうございました。

回答No.1

asahina02

いきなり答えを書いてしまうと勉強にならないと思うので、ヒントだけ。

・各行をループしつつ各列をループして全データを網羅する
・各ループには終了条件を設定（例えば空白）
・ループ中、セルデータをチェックし○の場合、
　シート２にデータを追記する
　この際、シート２に書いている行数を記憶

・各セルのデータはCells(行番号, 列番号)で取得可能
・ループはWhileループがちょうどいいでしょう

お礼

頭の中では、いただいたヒントで構想を練れるのですが
実際にマクロを組むとなると難しいものでした。。。
素早いご回答ありがとうございました。