アンケート調査を抽出

質問

プルダウンメニューをいくつか作ったアンケートが100あるとします。
例えばB3で「いいえ」が選択されたアンケートだけをファイル名だけどこかに一覧するようなやり方はありませんでしょうか？

目的としてはアンケートを各社員にとってファイル名を社員番号で保存してもらい送ってもらった100のファイルの中から「いいえ」を選んだ社員を一覧化したいのです。

どうぞよろしくお願いいたします。

回答No.2

DOUGLAS_ · ベストアンサー

＞例えばB3で「いいえ」が選択されたアンケートだけ
　実用的には、「B3」だけではないと存じますので、こちらで勝手にアレンジさせていただきました。

１）「どこかに一覧するようなやり方」のブックを用意し、セルA1 に「社員番号」と入力します。
２）B1・C1・D1・・・ に「Ａ１」・「Ｂ２」・「Ｂ３」・「Ｄ１」・「Ｄ３」のようなアンケートの入力されたセル番地を入力します。
３）最後に、下記のマクロを実行します。

　ただし、
＞送ってもらった100のファイル
の保存先は
D:\hoge\hoge\
というフォルダ（パス）にしてあります。

＞B3で「いいえ」が選択されたアンケートだけをファイル名だけどこかに一覧
したい場合は、添付画像でいうと、Ｄ１のフィルタから「いいえ」を選択すると、Ａ列に「一覧」ができます。

Sub TEST()
　Application.ScreenUpdating = False
　Dim MyPath As String, MyName As String
　Dim MyList() As String, n As Integer
　Dim i As Integer, j As Byte

　'古いデータをクリア
　ActiveSheet.UsedRange.Offset(1).ClearContents

　'「送ってもらった100のファイル」の保存フォルダのパスを指定
　MyPath = "D:\hoge\hoge\"

　'「送ってもらった100のファイル」の一覧を配列に格納
　MyName = Dir(MyPath & "*.xls")
　Do While MyName <> ""
　　ReDim Preserve MyList(n)
　　MyList(n) = Replace(MyName, ".xls", "")
　　MyName = Dir
　　n = n + 1
　Loop

　'Ａ列に社員番号一覧を記入
　Range("A2").Resize(UBound(MyList()) + 1) = Application.Transpose(MyList())

　'２行目以下に１行目の各人のアンケート結果を記入
　For j = 2 To Range("B1").End(xlToRight).Column
　　For i = 2 To Range("A2").End(xlDown).Row
　　　Cells(i, j).Formula = "='D:\hoge\hoge\[" & Cells(i, 1).Value & _
　　　　".xls]Sheet1'!" & Cells(1, j).Value
　　Next
　Next
　If Not ActiveSheet.AutoFilterMode Then Range("B1").AutoFilter
　Application.ScreenUpdating = True
End Sub

お礼

完璧です。
言葉足らずな質問に
>実用的には、「B3」だけではないと存じますので
と実用的に作っていただいたことに何より感謝です。
さらに画像まで添付していただき、こんなに丁寧な回答をいただいたのは初めてでした。

すばらしかったです。
本当にありがとうございました。

回答No.3

DOUGLAS_

[回答番号：No.2] の DOUGLAS_ です。

　間違いではありませんが、少し変更します。

Cells(i, j).Formula = "='D:\hoge\hoge\[" & Cells(i, 1).Value & _
　　".xls]Sheet1'!" & Cells(1, j).Value

の行は、

Cells(i, j).Formula = "='" & MyPath & "[" & Cells(i, 1).Value & _
　　".xls]Sheet1'!" & Cells(1, j).Value

の方がよいですね。

　それと、アンケート結果の記入されたシートの名前は一律「Sheet1」にしてありますが、誰かがイタズラでシート名を変えていらっしゃったりしたら、[シートの選択] ダイアログが表示されます。

回答No.1

hige_082

マクロなら出来ますけど
質問の情報だけでは、どうすることも出来ません
やりたいことだけ書かれてもねえ
他の似たような質問の内容を見るなどして、必要な情報は提示しないと
それとも、できるか出来ないかだけ聞きたいの？

一応、サンプルを提示してみますが、必要な情報が無いので、このままでは動作しません
必要な所を書き換えてテストしてみてください

Sub test()
Dim i As Integer
Dim 社員番号 As Integer
Dim フォルダ名 As String
Dim シート名 As String
Dim 社員番号ファイル名 As String
Dim 集計ファイル As Workbook
Set 集計ファイル = ActiveWorkbook
シート名 = "処理対象シート名"
フォルダ名 = "C:\対象ファイルのあるフォルダ名"
For i = 1 To 100
社員番号 = i
社員番号ファイル名 = 社員番号 & ".xls"
Workbooks.Open filename:=フォルダ名 & "\" & 社員番号ファイル名
If Workbooks(社員番号ファイル名).Worksheets(シート名).Range("B3").Value = "いいえ" Then
集計ファイル.Sheets("sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Value = 社員番号
End If
Workbooks(社員番号ファイル名).Close
Next
End Sub

以上、参考まで

お礼

説明不足で申し訳ございません。

とても参考になりました。
ありがとうございました！