[[20180511144412]] 『列見出し名を抽出したい』(あう) ページの最後に飛ぶ

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『列見出し名を抽出したい』(あう)

以下の表組を、記号を軸に列見出し名を抽出するにはどのような計算式になるでしょうか。
ご教示のほどお願いします。

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

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

■商品1
〇:大阪 横浜 神戸

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

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

何卒よろしくお願いします。

< 使用 Excel:Excel2016、使用 OS:Windows10 >


Sub main()
    'シート[list]に結果表示
    '元表をアクティブにした状態で実行
    Dim c As Range, f As Range, fn As Range, d As Variant
    Sheets("list").Cells.Clear
    Set r = Sheets("list").Range("A1")
    For Each c In Range("A:A").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("list").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("list").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
(mm) 2018/05/11(金) 15:31

mmさま

ご教示ありがとうございます!

自分じゃ絶対できませんでした・・。

マクロ設定も初めてなので、ちょっと挑戦してみます!

非常に助かりました。
(あう) 2018/05/11(金) 16:19


先日質問させていただいた者です。

上記のVBAを使用させていただいたところ、
以下のように結果が実行されました。

↓↓↓

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

上記から不要な箇所を取って、以下のように表記したいのですが、
どうしたらいいでしょうか。
(推測では「r.Value = "■" & c.Value」かなと思い、
いろいろ試してみましたができませんでした。)

↓↓↓

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

どうぞご教示のほどお願いします。

(あう) 2018/05/16(水) 11:09


コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.