способ найти строку в объединенных ячейках

Question

Мне нужно поискать в файлах в каталоге вхождения строки и вернуть счетчик.

Для тестирования я поместил 4 книги по 5 листов в папку C: \ test. Я ищу подсчет вхождений слова аммиак в любом месте рабочих книг. Код, который я использую, переустанавливает «0», хотя я уверен, что он существует. Я верю, потому что lookin не работает с объединенными клетками. Есть какие-нибудь хитрости для того, чтобы сделать эту работу?

Sub LoopThroughFiles()
Range("'sheet1'!A6:M10000").ClearContents

Dim directory As String, fileName As String, sheet As Worksheet, i As Integer, j As Integer
directory = "C:\Test\"
fileName = Dir(directory & "*.xl??")



i = 5
Do While fileName <> ""

i = i + 1

If fileName <> "" Then
Dim wbk As Workbook
With wbk
Set wbk = Workbooks.Open(directory & fileName)
End With


Dim sh As Worksheet
Dim found As Range
Dim count As Integer

For Each sh In wbk.Worksheets
    Set found = sh.Cells.Find(what:="Ammonia", LookIn:=xlFormulas)


    If Not found Is Nothing Then
       sh.Activate
       found.Select
        count = count + sh.Range(found.Address).Offset(0, 3).Value
       Else
    End If
Next sh
wbk.Close
End If



fileName = Dir()

Loop

Range("'Sheet1'!C2").Value = count

End Sub

Код не находит значение в объединенной ячейке.

Answer 1

Добро пожаловать на SO.

Код, который вы указали, близок к тому, каким он должен быть. Тем не менее, он найдет только одно вхождение на листе. Я не уверен, что это так, поэтому в следующем коде я демонстрирую, как вы можете найти все вхождения на листе.

Кроме того, я не уверен, что понимаю логику того, как вы увеличиваете count в каждом цикле. В настоящее время ваш код находит ячейку со значением «Аммиак», а затем переходит на 3 ячейки вправо и добавляет любое значение в count. Опять же, я не уверен, что это так.

Кроме того, вам не нужны ни sh.Activate, ни found.Select.

Ниже приведен код, который я бы предложил, вместе с комментариями, объясняющими, как он работает.

Option Explicit

Sub LoopThroughFiles()
'
' your code to loop through workbooks
'

Debug.Print numOfOccurrences("Ammonia", wbk) 'call the search function and print the number of occurrences to the immediate window

'
' your code continues
'

End Sub

Public Function numOfOccurrences(keyword As String, wb As Workbook) As Long

Dim sht As Worksheet
Dim found As Range
Dim count As Long
Dim firstOccurence As String
count = 0

For Each sht In wb.Worksheets 'loop through sheets
    Set found = sht.Cells.Find(what:=keyword) 'search for the first occurrence if any
    If Not found Is Nothing Then 'if the keyword is found once, then we need to search for more occurrences
        firstOccurence = found.Address 'store the address of the first occurence
        Do
            Set found = sht.Cells.FindNext(found) 'search for the next occurrence in the same sheet
            count = count + 1 'keep track of the number of occurences
        If found Is Nothing Then
            GoTo DoneFinding    'this deals with what seems to be a bug when using .FindNext with merged cells
        End If
        Loop Until found.Address = firstOccurence 'repeat until the search goes full circle back to the first occurrence
    End If
DoneFinding:
Next sht
numOfOccurrences = count

End Function