Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

56290 / 76737

←次へ　｜　前へ→


	【25204】Re:文字列検索

小僧 - 05/5/24(火) 11:21 -


	引用なし

	パスワード

▼masa さん：
こんにちは。

ご提示されたコードですと、コンパイルエラー等のため
「Find」のエラーにたどりつけません…。
こんな感じのコードなのでしょうか？

Sub Logフォルダへ()
Dim fn As Variant
Dim fnn As Variant
Dim schWhat As String '検索文字
Dim fndCell As Range '検索したセル
Dim cntx As Integer
Dim objsh As Worksheet
Dim myPath As String
Dim mySheet As Worksheet
Dim FirstAddress As String
Dim FndFLG As Boolean
Dim LogPath As String
　　
　　Application.ScreenUpdating = False
　　
　　myPath = "C:\m\"
　　LogPath = "c:\log\
　　
　　schWhat = InputBox("検索文字を入力して下さい。")
　　If schWhat = "" Then Exit Sub

　　fn = Dir(myPath & "*.xls")
　　
　　Do While fn <> ""
　　　　
　　　　FndFLG = False
　　　　Workbooks.Open myPath & fn
　　
　　　　For Each mySheet In ActiveWorkbook.Sheets
　　　　
　　　　With mySheet.Cells
　　　　　　Set fndCell = .Find(schWhat, LookIn:=xlValues)
　　　
　　　　　　If Not fndCell Is Nothing Then
　　　　　　Set objsh = Worksheets.Add _
　　　　　　　　　　　　(After:=Worksheets(Worksheets.Count))
　　　　　　　　objsh.Name = "dummy"
　　　　　　　　FndFLG = True
　　　　　　　　FirstAddress = fndCell.Address
　　　　　　　　cntx = 0
　　　　　　　　Do
　　　　　　　　　　With objsh
　　　　　　　　　　　　.Range("A1").Offset(0, cntx).Value = fn
　　　　　　　　　　　　.Range("A2").Offset(0, cntx).Value = mySheet.Name
　　　　　　　　　　　　.Range("A3").Offset(0, cntx).Value = fndCell.Address
　　　　　　　　　　End With
　　　　　　　　　　Set fndCell = .FindNext(fndCell)
　　　　　　　　　　cntx = cntx + 1
　　　　　　　　Loop While Not fndCell Is Nothing And fndCell.Address <> FirstAddress
　　
　　　　　　End If
　　　　End With
　　Next
　
　 If FndFLG Then
　　　　fnn = LogPath & Left(fn, (Len(fn) - 4)) & ".csv"
　　　　Application.DisplayAlerts = False
　　　　ActiveWorkbook.SaveAs Filename:=fnn
　　End If
　　　　ActiveWorkbook.Close SaveChanges:=False
fn = Dir()
Loop

Application.ScreenUpdating = True
Set objsh = Nothing
MsgBox "終了"
End Sub

0 hits

▼

【25185】文字列検索 masa 05/5/24(火) 0:02