.FindNext не «оборачивается», когда значение найдено в объединенной ячейке - PullRequest
0 голосов
/ 27 июня 2019

Итак, когда я отвечал на этот вопрос , я обнаружил, что мне приходится иметь дело с тем, что кажется довольно странной ошибкой.

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

Таким образом, если первое (и единственное) вхождение ключевого слова найдено в ячейке, построенной путем объединения двух ячеек одного столбца, то .FindNext вернет Nothing.

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

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

Это ошибка?Я что-то упустил?

Вот код для завершения:

Sub main()

Dim wbk As Workbook
Set wbk = ThisWorkbook
Debug.Print numOfOccurrences("test", wbk) 'call the search function and print the number of occurrences to the immediate window

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

1 Ответ

0 голосов
/ 27 июня 2019

Из того, что я видел, Excel обрабатывает объединенную область как одну ячейку, поэтому FindNext не найдет другую присутствующую ячейку, если будет только одна объединенная область со значением. Вы можете получить доступ к полному адресу диапазона, используя Range.MergeArea

Вот общая функция FindAll, которая при желании отзовет объединенные области в пределах диапазона ...

Private Function FindAll(What, _
    Optional SearchWhat As Variant, _
    Optional LookIn, _
    Optional LookAt, _
    Optional SearchOrder, _
    Optional SearchDirection As XlSearchDirection = xlNext, _
    Optional MatchCase As Boolean = False, _
    Optional MatchByte, _
    Optional SearchFormat, _
    Optional IncludeMerged As Boolean = False) As Range

    'LookIn can be xlValues or xlFormulas, _
     LookAt can be xlWhole or xlPart, _
     SearchOrder can be xlByRows or xlByColumns, _
     SearchDirection can be xlNext, xlPrevious, _
     MatchCase, MatchByte, and SearchFormat can be True or False. _
     Before using SearchFormat = True, specify the appropriate settings for the Application.FindFormat _
     object; e.g. Application.FindFormat.NumberFormat = "General;-General;""-""" _
     Set IncludeMerged to 'True' to include all cells within a merged area

    Dim SrcRange As Range
    If IsMissing(SearchWhat) Then
        Set SrcRange = ActiveSheet.UsedRange
    ElseIf TypeOf SearchWhat Is Range Then
        Set SrcRange = IIf(SearchWhat.Cells.Count = 1, SearchWhat.Parent.UsedRange, SearchWhat)
    ElseIf TypeOf SearchWhat Is Worksheet Then
        Set SrcRange = SearchWhat.UsedRange
    Else: SrcRange = ActiveSheet.UsedRange
    End If
    If SrcRange Is Nothing Then Exit Function

    'get the first matching cell in the range first
    With SrcRange.Areas(SrcRange.Areas.Count)
        Dim FirstCell As Range: Set FirstCell = .Cells(.Cells.Count)
    End With

    Dim CurrRange As Range: Set CurrRange = SrcRange.Find(What:=What, After:=FirstCell, LookIn:=LookIn, LookAt:=LookAt, _
        SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)

    If Not CurrRange Is Nothing Then
        Set FindAll = IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange)
        Do
            Set CurrRange = SrcRange.Find(What:=What, After:=CurrRange, LookIn:=LookIn, LookAt:=LookAt, _
            SearchDirection:=SearchDirection, MatchCase:=MatchCase, MatchByte:=MatchByte, SearchFormat:=SearchFormat)
            If CurrRange Is Nothing Then Exit Do
            If Application.Intersect(FindAll, CurrRange) Is Nothing Then
                Set FindAll = Application.Union(FindAll, IIf(IncludeMerged = True, CurrRange.MergeArea, CurrRange))
            Else: Exit Do
            End If
        Loop
    End If
End Function
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...