エクセルシートにある１０００～２０００件程度のデータの下記のような処理を
効率的に行う方法を教えてください。
アンケートの自由回答欄から効率的にデータを取り出したいと思っています。
自由回答欄は、２００文字程度です。
その中から例えば、｢楽しかった｣を含むデータを取り出したいと思っています。
（または、なんらかの印を付けたいと思ってます。）
「楽しかった」だけではなく、「よかった」「悪かった」「良かった」など
抜き出すキーワードは複数（２０ワードくらい）あります。
そういうアンケートのエクセルのファイルは、３００くらいあって、
ファイル名は様々です。
キーワードを含むセルを区別できれば、なおありがたいです。
エクセルは、２００３です。
できれば、エクセルのみで処理できればありがたいです。
その他の方法でも結構ですが、その場合はなるべく費用が掛からないような
方法でお願いします。（ちなみに、アクセスは保有してません）
できるだけ具体的に手順回答いただいた方にポイントを配分させて頂きます。
よろしくお願いします。
ベストアンサー
-
minubow
満足100pt
関数で、ＦＩＮＤ（探したい文字，対象セル）により、
探したい文字が含まれていればＴＲＵＥ、含まれていなければＦＡＬＳＥを返します。
探したい文字が多いほど、行は必要になりますが、使える関数かと思います。
また、下記のように数式を組み合わせて使えば、１行で表現できます。
=(ISERROR(FIND("楽しかった",対象セル))=FALSE)+(ISERROR(FIND("よかった",対象セル))=FALSE)
⇒楽しかった、または、よかったが含まれているものが１、２になり、
含まれていないものが０になります。
いかがでしょうか？
-
samasuya
-
samasuyaその他の回答
-
e10kg
満足30pt
こんな感じでいかがでしょうか？
キーワードに一致するセルに色を付けています。
また、result.txt というファイルにブック名、キーワード、検索したセルの値を書いています。
-----
Option Explicit
Sub main()
Dim path As String
Dim fn As Integer
Dim nm As String
Dim i As Integer
Dim keyword As String
Dim keywords() As String
path = "c:\temp\" 'アンケートファイルがあるフォルダー
'探したいキーワード。数を増やしたいときは、カンマで区切ってここに追加。
keyword = "楽しかった,よかった,悪かった"
keywords = Split(keyword, ",")
fn = FreeFile
Open "c:\temp\result.txt" For Output As fn
nm = Dir(path & "\*.xls")
Do While nm <> ""
Workbooks.Open Filename:=path & nm
For i = LBound(keywords) To UBound(keywords)
Call markKeyword(fn, keywords(i))
Next i
ActiveWorkbook.Close True '保存しない場合は、Falseに。
nm = Dir
Loop
Close #fn
End Sub
Sub markKeyword(fn As Integer, keyword As String)
Dim rng As Range
Dim add As String
With ActiveSheet
Set rng = .Cells.Find(What:=keyword, After:=.Range("A1"), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchDirection:=xlNext)
If rng Is Nothing Then Exit Sub
add = rng.Address
Print #fn, ActiveWorkbook.Name & vbTab & keyword & vbTab & rng
rng.Interior.ColorIndex = 6 '色を付けたくなければココをコメントに。
Do
Set rng = .Cells.FindNext(After:=rng)
If add = rng.Address Or rng Is Nothing Then Exit Sub
rng.Interior.ColorIndex = 6 '色を付けたくなければココをコメントに。
Print #fn, ActiveWorkbook.Name & vbTab & keyword & vbTab & rng
Loop
End With
End Sub
-
samasuya
-
- その他の回答を読む
この質問へのコメント
質問の情報
- 登録日時
- 2008-03-27 14:31:16
- 終了日時
- 2008-03-31 12:16:10
- 回答条件
- 1人1回まで
この質問のカテゴリ
この質問に含まれるキーワード
人気の質問
-
経験者の方や詳しい方にお聞きしたいです。 親が亡くなった後に親と一緒に暮らしていた親族が遺産隠しや他…
tomo2024tomo
1
1
2
-
もし２０００年代前半からn高があったら日本は変わっていたと思いますか？ 最近の１０代の子どもの多くはn…
匿名質問者11
-
aiで作った女の子が気持ち悪く感じるのは、保存してあるいろんな女の子のパーツからaiが探してきてつけてる…匿名質問者1
-
画像を1ストローク程度でフォルダ分けできるAndroidアプリはありますか？ 例えばTwitterの画像にはイラスト…
Lamron🖇
-
この肌って色白な方ですか？匿名質問者
下記のWSHで動作させれば、一気に沢山のファイルを処理できます。
ただし、300個まで行くかどうかは試していません（Windowsの引数制限に引っかかる可能性あります）
Step1. 下記をxxx.vbsで保存
Step2. 必要なExcelファイルを複数選択して、xxx.vbsへドラッグ＆ドロップする
ヘッダは１行目、アンケートの回答内容はA列と仮定して作ってあります。違う場合は定義のところを変更してください。
Option Explicit
Dim strArg, oXL
Set oXL = CreateObject("Excel.Application")
oXL.Visible = True
For Each strArg In WScript.Arguments
' wscript.echo strArg
call SetNameAndExp(strArg)
next
oXL.Quit()
set oXL = Nothing
Const iRHeader = 1 'ヘッダ行の位置
Const iCContents = 1 'アンケート結果文字列の列位置
Sub SetNameAndExp(sFile)
Dim sKeyword, sKeywords, oB
With oXL
set oB = .Workbooks.Open(sFile)
sKeywords = "楽しい,良い,悪い" '★キーワードはここを変更する
sKeyword = Split(sKeywords, ",")
Dim iC
For iC = iCContents + 1 To iCContents + 1 + UBound(sKeyword)
.Cells(iRHeader, iC).Value = sKeyword(iC - (iCContents + 1))
Next
'キーワードをヘッダ行へ設定
.ActiveWorkbook.Names.Add "key", "=$" & iRHeader & ":$" & iRHeader
Dim sColAbs
sColAbs = .Columns(iCContents).Address(True, True)
.ActiveWorkbook.Names.Add "cont", "=" & sColAbs & ":" & sColAbs
Dim lLastR, iLastC, rTop
Set rTop = .Cells(iRHeader, iCContents)
rTop.CurrentRegion.Select
lLastR = .Selection.Rows.Count
iLastC = .Selection.Columns.Count
' AutoFilterの設定
.Selection.AutoFilter
' 有無判別式を全領域へ入れる
.Range(.Cells(iRHeader + 1, iCContents + 1), _
.Cells(lLastR, iLastC)).Formula = _
"=IF(ISERROR(FIND(key,cont)),"""",1)"
rTop.Select
.ActiveWorkbook.Save
.ActiveWorkbook.Close
End With
End Sub
＞個別に処理しないといけないのでマクロ登録は面倒ですね・・・。
excelマクロでやる場合、別ファイルであっても、個人用マクロブックへ登録して操作すれば面倒なことはないです。
エディタなどで、全角スペースを半角スペース2文字に変更をお願いします。
（見やすくするために半角空白２文字を全角スペースに変えたのが、あだになった）
後、Windowsの制限は多分無いので、何個でも食わせられます。
先ずはバックアップを採取しておいてから、適当な個数をドラッグ＆ドロップしてみてください。
前のコメントで書いた個人用マクロブックというのはご存知なのですよね？
個人用マクロブックは、知りませんでしたがこれは自分で調べます。
vbaで開発したことないですが、コードは、自分でもなんとか調べられますので
問題ないです。
今回の質問は、プログラミング、関数利用等のヒントが欲しかっただけなのです。
ポイント付与の際は、コメント欄の内容も加味させていただきますね、
ありがとうございます。
貼り付けてmain()を実行してください。
#回答が遅れてすいません。