エクセルシートによるアンケート集計

2011/8/27更新

エクセルをアンケート用紙として配布し、その返信ファイルを使ってデータの集計をするのですね。
これは大変な仕事です。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−
まず、アンケート用のシートは項目を左にして、データを項目の右に入力してもらえるようなシートを作成します。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−
例えば次のようにします。
A列に項目名をあらかじめ入力しておきます。
B列には回答を入力してもらいます。
ファイル「集計表」の1行目と同じ、項目名を次のように入力しています。
ファイル「アンケート」の1列目には、該当する項目名のみを入力します。
この項目名の順番は入れ替えても、項目名と同じ項目のＢ列のデータが貼り付けされます。
また、複数のシートであっても、A列の項目名が同じであれは、B列のデータを入力して集計表に集計できます。
ファイル「アンケート」

	A	B
1	[お名前（姓）]	山田
2	[お名前（名）]	太郎
3	[種別]	法人
4	[貴社名]	（株）山田
5	[部署名]	総務部
6	[業種]	その他
7	[郵便番号1]

ファイルを返信してもらいますが、ファイル名は皆同じ名前で帰ってしまっては困りますので、名前でファイル名を付けてもらうようにします。
例えば、山田太郎.xls
−−−−−−−−−−−−−−−−−−−−−−−−−−−−
次に集計用にファイルを作成しておきます。
ファイル「集計表」の1行目に、項目名を次のように入力しています。
この項目名の順番は入れ替えても、項目名と同じデータが貼り付けされます。

集計は、項目が列に並んでいる状態にすると自動集計が簡単にできますのでこのようにします。
データは、項目の下に入力されます。
ファイル「集計表」

	A	B	C	D	E	F
1	[お名前（姓）]	[お名前（名）]	[種別]	[貴社名]	[部署名]	[業種]
2	山田	太郎	法人	（株）山田	総務部	その他
3

−−−−−−−−−−−−−−−−−−−−−−−−−−−−
元のデータの並びが縦で、集計表のデータの並びが横になりますので、データの行列を入れ替えて貼り付けすることが必要です。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−
集計表にデータを貼り付けるために集計表のファイルを開きます。
返信されたファイルを開き、セルB1:B6を選択し「編集」「コピー」します。
「ウィンドウ」で「集計表」のファイルを選択し、貼り付け先のセルを選択し、「編集」「形式を選択して貼り付け」で、「行列を入れ替える」にチェックを入れ「ＯＫ」とします。
このように手作業で、全てのファイルのデータをコピー貼り付けするのは大変です。
できれば「マクロ」を使って自動化したいですね。
集計用の保存フォルダと同じフォルダに全てのアンケートファイルが保存されていて、コピーするセルの範囲も固定していれば、簡単にマクロを作れます。
例えば、
アンケートからコピーするシート名はSheet1で、セル範囲がB1:B10とします。
集計表のデータ貼り付け先のシート名はSheet1で、セル範囲がA2以降とします。

---

マクロで自動で集計表にデータをコピーする物を作成してみました。
マクロが記述されたファイルを使用する場合は事前に「マクロ」の「セキュリティ」を「中」又は「低」にしておく必要があります。
また、このファイルはアンケート集計専用のフォルダを作成して保存してください。

見本の集計表ファイルとアンケートファイル
syukeihyo.exe 46.7kB
このファイルは圧縮されていますが、ダブルクリックすると自動で解凍されます。
解凍後のファイルは次の２つです。
集計表.xls      44.0kB
アンケート.xls  21.0kB

---

集計表の保存先のフォルダ内にある他のエクセルシート全てに対してセルB1:B10のデータを「行列を入れ替えて」貼り付けます。
したがって、フォルダはアンケート結果と、集計表以外の他のエクセルシート含まれていないようにしてください。
(Ａ列の項目名が違っていれば、他のファイルがあってもデータは貼り付けされません。)
−−−−−−−−−−−−−−−−−−−−−−−−−−−
「マクロ」を使用して集計表にアンケートのデータをコピーするには「ツール」「マクロ」「マクロ」から「集計表.xls!Module1.データ貼り付け」を選択してください。

一度実行すると途中で動作は止められません。
データは、最終行以降にどんどん追加されますので、同じデータでも重複して貼り付けられます。
貼り付けが済んだ元のアンケートデータのファイルは、別のフォルダに保存することをおすすめします。
また、実行後の結果を元に戻すこともできません。
失敗した場合も、ファイルを保存しない限り、問題ないと思います。
−−−−−−−−−−−−−−−−−−−−−−−−−−−

マクロコードは次の様になります。
Sub データ貼り付け()

' データ貼り付け Macro
' アンケートから集計表にデータを貼り付けます。
'

'
'エラーが発生した場合行番号enに飛びます
On Error GoTo en
'画面更新しません
Application.ScreenUpdating = False
'このブックの保存先フォルダを変数phに代入
ph = ThisWorkbook.Path & "\"
ChDrive Left(ph, 1)
ChDir ph

'ファイルを検索して、変数FsFileに代入します
Application.ScreenUpdating = False
    fsfile = Dir(ph)
    If fsfile = "" Then GoTo en
'処理ファイル数の開始数を1とする
S_C = 0

'ファイルがなくなるまで繰り返し
While fsfile <> ""
'検索したファイルのi番目の名前を変数fnに代入
    fn = fsfile
'もし変数fn がこのブックの名前と同じ場合は、行番号neへ
    If fn = ThisWorkbook.Name Then GoTo ne
'ブック fnを開く
    Workbooks.Open fn
'処理ファイル数を1追加
S_C = S_C + 1

'変数fwcにシート数を代入
    fwc = Sheets.Count
'変数 fnに開いたブックの名前を代入
    fn = ActiveWorkbook.Name
'このファイルをアクティブにする
    ThisWorkbook.Activate
'シート"Sheet1"を選択
    Sheets("Sheet1").Select
'画面更新する
    Application.ScreenUpdating = False
'集計のセルA65536から上に見て最初の行番号+1を変数rcに代入(最終データ)
    rc = Range("A65536").End(xlUp).Row + 1
'集計のセルIV1から左に見て最初の列番号を変数ecに代入（項目数）
    ec = Range("IV1").End(xlToLeft).Column
'開いたファイルの項目数
    opr = Workbooks(fn).Sheets("Sheet1").Range("A65536").End(xlUp).Row
'項目数を大きい方にする
    If ec < opr Then ec = opr
'変数wcを1から変数fwcまで繰り返し
    For wc = 1 To fwc
'変数r を　1から ecまで繰り返し
        For r = 1 To ec
'変数cを 1から　ecまで繰り返し
            For c = 1 To ec
            With ThisWorkbook.Sheets("Sheet1")
'このブックの項目名と開いたファイルの項目名が同じ場合貼り付け
            If .Cells(1, c) = Workbooks(fn).Sheets(wc).Cells(r, 1) And .Cells(1, c) <> "" Then
                .Cells(rc, c) = Workbooks(fn).Sheets(wc).Cells(r, 2)
                Else
            End If
            End With
'変数cを次の値にして、For cに戻る
            Next c
'変数rを次の値にして、For rに戻る
       Next r
'変数rcに集計の最終行+1の値を代入
    rc = Range("A65536").End(xlUp).Row + 1
'変数 wcを次の値にして、For　wcに戻る
        Next wc
'ウィンドウ(開いたファイル)を閉じる
Windows(fn).Close False
'　変数 iを次の値にして　For　iに戻る
ne: '    Next i
        fsfile = Dir()
'    End If
    Wend

'画面更新する
Application.ScreenUpdating = True
'メッセージを表示
MsgBox S_C & "個のファイルを処理しました"
'処理を終了する
Exit Sub
'メッセージを表示する
en: MsgBox "予期せぬエラーが発生しました。"
'画面更新する
Application.ScreenUpdating = True
End Sub

−−−−−−−−−−−−−−−−−−−−−−−−−−−−
マクロを修正する場合は「ツール」「マクロ」「VisialBasic Editer」を選択します。
「プロジェクト」VBAProject（集計表.xls）の「標準モジュール」のModule1をダブルクリックして、マクロ内容を表示できます。
マクロは、ワープロソフトと同じように修正できます。
エクセルシートに戻る場合は「ファイル」「終了してMicrosoft Excelに戻る」を選択してください。
−−−−−−−−−−−−−−−−−−−−−−−−−−−−−

−−−−−−−−−−−−−−−−−−−−−−−−−−−−
ご不明な点があれば、ご質問下さい。