複数回答式のアンケート入力で回答を1セルにまとめて手入力し，事後的に各項目への振り分けをさせるときに使うスクリプトです．

可能であればウェブに回答フォームを設けるなどして，手入力しなくて済むようにすべきです．

目次

  1. 使い方
    1. マクロ実行前
    2. マクロ実行後
  2. マクロ

使い方

A列にID，B列では項目をわけずにまとめて記号を手入力していくとします．
例えば，入力時点ではB列に「Fox」などと打っておきます．

C列以降の1行目で「F」「o」「x」という見出しの列がそれぞれあるとすれば，マクロは「F」「o」「x」に該当する列それぞれにフラグを分解して入れて「1」と入れてくれます．
フラグは英数1文字と想定しています．

マクロ実行前

次のようなExcelファイルが作られているとします．

ID 記号 a b c d
1 c
2 bd
3 aa
4 z

マクロ実行後

マクロを実行すると次のようにフラグが入ります．

ID 記号 a b c d
1 c 1
2 bd 1 1
3 aa 1
4 z
  • 重複は無視して，1行につき1回のみのカウントされるため，ID3の行はaのフラグが2ではなく，1となります．
  • 「z」という見出しはないので，ID4の行にはフラグが立ちません．

マクロ

Sub フラグ分解()

    Dim i, j As Long
    Dim maxcol As Long
    Dim strcol As Long: strcol = 2 '分解する項目群が入っている列番号。フラグ分解に用いるため、以降の列では各フラグとなる英数1文字を見出しである1行目に記しておくこと。
    Dim str As String

    i = 2 '2行目から実行
    maxcol = Cells(1, nombreCol).SpecialCells(xlLastCell).Row
    Do While Cells(i, 1) <> "" '1列目が空白となるまでマクロを実行
        For j = strcol + 1 To maxcol
            str = Cells(i, strcol).Value
            If InStr(str, Cells(1, j).Value) > 0 Then
                Cells(i, j) = 1
            End If
        Next j
        i = i + 1
    Loop

End Sub