本日のリベンジ分

複数ファイルに対して複数単語検索をかけるVBAのサンプルです。

 （ソース　ここから）

Sub ボタン1_Click()

Dim myFile As Variant
Dim f As Variant

ChDir "C:\Users\Admin\Desktop"
myFile = Application.GetOpenFilename( _
FileFilter:="Excel ファイル (*.xls; *.xlsx),*.xls; *.xlsx", _
MultiSelect:=True)

'【ループ】ファイル選択ループ
If IsArray(myFile) Then
For Each f In myFile
Debug.Print f

Workbooks.Open f

'アクティブワークブックのシート数
Set aSheets = ActiveWorkbook.Worksheets
sCount = aSheets.Count
Debug.Print (sCount)

'検索単語数
Set sSheet = Workbooks("開発.xlsm").Worksheets("用語")


MaxRow = sSheet.UsedRange.Rows.Count
MaxCol = sSheet.UsedRange.Columns.Count

'使用最大行
Debug.Print (MaxRow)


'【ループ】シート
For i = 1 To sCount
Set nowSheet = Worksheets(i)


'【ループ】単語
For j = 1 To MaxRow - 1

keyWord = sSheet.Cells(j + 1, 1).Value
' Debug.Print (j)
Debug.Print (keyWord)

Dim beforelngYLine
Dim beforeintXLine

Dim lngYLine As Long
Dim intXLine As Integer
Dim objFind As Object
Dim strAddress As String

Set objFind = nowSheet.Cells.Find(keyWord)
Debug.Print (nowSheet.Name)
If Not objFind Is Nothing Then
strAddress = objFind.Address
Do While Not objFind Is Nothing
Debug.Print ("Loop")
lngYLine = objFind.Cells.Row
intXLine = objFind.Cells.Column
MsgBox keyWord + "、" + CStr(lngYLine) + "行目の" _
+ CStr(intXLine) + "列目にあります"
Debug.Print (CStr(lngYLine) + "行目 " + CStr(intXLine) + "列目にあります")

Set objFind = nowSheet.Cells.FindNext(objFind)

Debug.Print (strAddress + "---" + CStr(objFind.Address))
If strAddress = CStr(objFind.Address) Then
Exit Do
End If

Loop
Else
' MsgBox "見つかりませんでした"
End If

Next j

Next i

ActiveWorkbook.Close

'ファイル選択ループ（後ろ）
Next
Else
Debug.Print myFile
End If

End Sub

（ソース　ここまで）

急いで書き残してるのでインデントは修正していない。