[[20180518130846]]　『VBA：不要な情報を消す方法』（ああ）　ページの最後に飛ぶ

『VBA：不要な情報を消す方法』（ああ）

再質問となります。
以前、以下の表組を、記号を軸に列見出し名を抽出するコードをいただきました。
使用してみましたところ、不要な情報も抽出されてしましたが、どこをどう変更していいかわかりません。
ご教示のほどお願いします。

	A	B	C	D	E
1		大阪	横浜	神戸
2	商品1	〇	〇	〇
3	商品2	×	〇	△
4	商品3	△	×	△

↓↓↓このような結果にしたいです。

■商品1
〇：大阪　横浜　神戸
■商品2
〇：横浜
△：神戸
×：大阪
■商品3
△：大阪　神戸
×：横浜

↓↓↓前回このようなコードをいただきました。

Sub main()

    'シート[Sheet2]に結果表示
    '元表をアクティブにした状態で実行
    Dim c As Range, f As Range, fn As Range, d As Variant
    Sheets("Sheet2").Activate
    Set r = Sheets("Sheet2").Range("A1")
    For Each c In Range("F1:I4").SpecialCells(2)
        r.Value = "■" & c.Value
        Set r = r.Offset(1)
        For Each d In Array("〇", "△", "×")
            Set f = c.EntireRow.Find(d, , , xlWhole)
            If Not f Is Nothing Then
                r.Value = d & ":"
                Sheets("Sheet2").Cells(r.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = f.EntireColumn.Cells(1)
                Set fn = f
                Do
                    Set f = c.EntireRow.FindNext(f)
                    If f.Address = fn.Address Then
                        Exit Do
                    Else
                        r.Value = d & ":"
                        Sheets("Sheet2").Cells(r.Row, Columns.Count).End(xlToLeft).Offset(, 1).Value = f.EntireColumn.Cells(1)
                    End If
                Loop
                Set r = r.Offset(1)
            End If
        Next d
    Next c
End Sub

↓↓↓結果このように表示されています。

■大阪
■横浜
■神戸
■商品1
〇: 大阪横浜神戸
■〇
〇: 大阪横浜神戸
■〇
〇: 大阪横浜神戸
■〇
〇: 大阪横浜神戸
■商品2
〇: 横浜
△: 神戸
×: 大阪
■×
〇: 横浜
△: 神戸
×: 大阪
■〇
〇: 横浜
△: 神戸
×: 大阪
■△
〇: 横浜
△: 神戸
×: 大阪
■商品3
△: 大阪神戸
×: 横浜
■△
△: 大阪神戸
×: 横浜
■×
△: 大阪神戸
×: 横浜
■△
△: 大阪神戸
×: 横浜

よろしくお願いします。

＜使用 Excel：Excel2016、使用 OS：Windows10 ＞

元質問は、[[20180511144412]] ですよね？そして貴方は「ああ」さんではなく、「あう」さんですよね？他人のフリしても良い事はなにもありませんよ？会う度に違う名前を名乗る相手を、貴方は信用できるでしょうか？

試してみましたが、元のmmさんのコード（コードだけ転記するのは失礼。ちゃんと作者名を明記しないと、著作権無視になります）で正しく動きましたよ？実行結果を、更に変換かけたような結果になっているようですが、「元表をアクティブにした状態で実行」と指示されているのに、なんで結果の方をアクティブにするコードなんて追加したのですか？指示に逆らってますよ。
（???） 2018/05/18(金) 14:11

 以前に投稿した質問なら、HNは変えないでください。

 ＞↓↓↓前回このようなコードをいただきました。

 自分で変更して旨くいかなくなったのに、
 さも回答者が提示したコードであるかの様な表現はしないでください。

 ＞    Sheets("Sheet2").Activate
 　　　　　　　　　　　↓
 (正)　Sheets("Sheet2").Clear

 ＞    For Each c In Range("F1:I4").SpecialCells(2)
 　　　　　　　　　　　　　↓
 (正)　For Each c In Range("F:F").SpecialCells(2)

 あと、元コードにも変数ｒの定義が無いようなので、
 「Dim r as Range」 も追加するといいと思います。

（半平太） 2018/05/18(金) 14:15

ルールを無視して失礼なことをして申し訳ありませんでした。
マクロ自体が初めてだったので、自分で検索しつつ触ってしまった部分もあり、その説明をせずにお手間を取らせてしまいました・・。
ご教示いただいてありがとうございます。
（ああ/あう） 2018/05/21(月) 13:54

コメント返信：

[ 一覧(最新更新順) ]

[[20180518130846]] 『VBA：不要な情報を消す方法』（ああ） ページの最後に飛ぶ

[[20180518130846]]　『VBA：不要な情報を消す方法』（ああ）　ページの最後に飛ぶ