Excel VBA質問箱 IV

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

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


56304 / 76732 ←次へ | 前へ→

【25185】文字列検索
質問  masa E-MAIL  - 05/5/24(火) 0:02 -

引用なし
パスワード
   はじめまして。以下のようにファイル内の全シートを文字列検索
するものですが、schRg.Findでエラーコード1004findを設定できません。
とエラーになります。かなりおおくのシートから検索するのでオーバ
フローかと思いましたがよくわかりません。
シートが多い場合と行、列がおおい場合によくエラーが出ています。

どなたかおしえていただけないでしょうか?


Dim fn As Variant
Dim fnn As Variant

Dim schSheet As String '検索シート
  Dim schColumns As String '検索列
  Dim schRg As Range '検索範囲
  Dim schWhat As String '検索文字
  Dim fndCell As Range '検索したセル
  Dim fstRow As Long '検索したセルの行
  Dim fstColumn As Integer '検索したセルの列
  Dim cntx As Integer
   Dim aa As Integer
   Dim ken As Variant
   Dim fnd As Integer
  
   Dim pp As Variant


 Dim objsh As Worksheet
 

txt = InputBox("ファイル形式 xls")
If txt = "" Then
GoTo endr
End If

schWhat = InputBox("検索文字を入力して下さい。")
If schWhat = "" Then
GoTo endr
End If


fn = Dir("c:\m\*.xls")
Do While fn <> ""
Workbooks.Open "c:\m\" & fn


    aa = Worksheets.Count
    fnd = 0
    cntx = 0
  
    Set objsh = Worksheets.Add(After:=Worksheets(aa))
    ' シート名を設定する
    objsh.Name = "dummy"


  For ii = 1 To aa
   Worksheets(ii).Select

  '検索範囲をセット
  Set schRg = Cells


  Set fndCell = schRg.SpecialCells(xlLastCell)

  '検索開始
  Set fndCell = schRg.Find(What:=schWhat, After:=fndCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, MatchByte:=False)
  '見つかった!
   If Not (fndCell Is Nothing) Then
    
    fstRow = fndCell.Row
    fstColumn = fndCell.Column
    Do
      cntx = cntx + 1
      fnd = 1
      'MsgBox "ありました! " & fndCell.Address
      Sheets("dummy").Select
      Sheets("dummy").Range("a" & cntx).Value = fn
      pp = InStr(1, fn, ".", vbTextCompare)
      ken = Left(fn, pp - 1)
      Sheets("dummy").Range("b" & cntx).Value = Worksheets(ii).Name
      Sheets("dummy").Range("c" & cntx).Value = fndCell.Address
      Worksheets(ii).Select
      
       Set fndCell = schRg.FindNext(After:=fndCell)
       Worksheets(ii).Select
      '最初に見つかったセルを再度見つけるまで続ける
    Loop Until (fndCell.Row = fstRow) And (fndCell.Column = fstColumn)
   End If
  Next
  
   If fnd = 1 Then
    fnn = "c:\log\" & ken & "log" & ".csv"
    Application.DisplayAlerts = False
    ActiveWorkbook.SaveAs Filename:=fnn
    ActiveWorkbook.Close SaveChanges:=False
   Else
    ActiveWorkbook.Close SaveChanges:=False

   End If


1 hits

【25185】文字列検索 masa 05/5/24(火) 0:02 質問
【25204】Re:文字列検索 小僧 05/5/24(火) 11:21 回答
【25206】Re:文字列検索 G-Luck 05/5/24(火) 11:51 発言

56304 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free