Найти список слов из диапазона, если слова выходят несколько раз - PullRequest
Новая
       32

Найти список слов из диапазона, если слова выходят несколько раз

0 голосов
/ 11 октября 2019

У меня есть список слов в Sheet1 Мне нужно соответствовать одно за другим от Sheets("Sheet2").Range("A1:A7500") до конца Range. Всякий раз, когда слово совпадает, мне нужно что-то с ним сделать в Sheet1. Это слово встречается несколько раз в Sheets("Sheet2").Range("A1:A7500").

. Следующий код: Поиск слова только один раз. Я не понимаю, где это идет не так. 

Sub XMAX()
Dim lrow As Long
Dim cel As Range
Dim oRng As Range: Set oRng = Sheets("Sheet2").Range("A1:A7500")
Dim oFoundRng As Range, oLastRng As Range


    lrow = Sheets("sheet1").Cells(Sheets("Sheet1").Rows.Count, "f").End(xlUp).Row
    '''''''''''''''Sheet1'''''''''''''''
    For Each cel In Range("f4:f" & lrow)

        If IsEmpty(cel.Value) = False Then

            Set oFoundRng = oRng.find(cel.Value)

            Do While Not oFoundRng Is Nothing

                    If UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
                        Range("X" & cel.Row).Value = "X"
                    ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "YO" Then
                        Range("V" & cel.Row).Value = "X"
                    ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "JAN" Then
                        Range("U" & cel.Row).Value = "X"
                    Else
                        MsgBox oFoundRng.Value
                    End If


                Set oLastRng = oFoundRng                    
                Set oFoundRng = oRng.FindNext(cel.Value)   'Getting Error(1004) here "unable to get findnext property of the range class" 
                If oLastRng >= oFoundRng Then               
                    Exit Do                                 
                End If
            Loop

        Else
        End If

    Next

Ответы [ 2 ]

1 голос
/ 11 октября 2019

Вы можете быть после этого (пояснения в комментариях): 

Sub XMAX()
    Dim cel As Range
    Dim oRng As Range: Set oRng = Sheets("Sheet2").Range("A1:A7500")
    Dim oFoundRng As Range
    Dim firstAddress As String

    With Sheets("sheet1") ' reference "Sheet1" sheet
        With .Range("f4", .Cells(.Rows.Count, "f").End(xlUp)) ' reference referenced sheet column "F" range from row 4 down to last not empty one
            If WorksheetFunction.CountA(.Cells) > 0 Then ' if there's at least one not empty cell
                For Each cel In .SpecialCells(xlCellTypeConstants) ' loop through referenced range not empty cells

                    Set oFoundRng = oRng.Find(what:=cel.Value, LookIn:=xlValues, lookat:=xlWhole) ' always specify at least 'LookIn' and 'LookAt' parameters, or they will be set as per last 'Find()' usage (even from Excel UI!)
                    If Not oFoundRng Is Nothing Then ' if a match found
                        firstAddress = oFoundRng.Address ' store first matched cell address
                        Do
                            Select Case UCase(oFoundRng.Offset(0, 1).Value2)
                                Case "ISAAC"
                                    .Range("X" & cel.Row).Value = "X"
                                Case "YO"
                                    .Range("V" & cel.Row).Value = "X"
                                Case "JAN"
                                    .Range("U" & cel.Row).Value = "X"
                                Case Else
                                    MsgBox oFoundRng.Value
                            End Select

                            Set oFoundRng = oRng.FindNext(oFoundRng) ' search for next occurrence
                        Loop While oFoundRng.Address <> firstAddress ' exit do when hitting fisr found cell again
                    End If

                Next
            End If
        End With
    End With
End Sub
1 голос
/ 11 октября 2019

Измените эту строку 

Set oFoundRng = oRng.FindNext(oFoundRng)

на 

Set oFoundRng = oRng.FindNext

Вы ищете не слово, а диапазон, который вы ранее нашли. На самом деле вам вообще не нужно передавать значение .FindNext.

Вы также должны изменить эту строку 

If oLastRng >= oFoundRng Then

на 

If oLastRng.Row >= oFoundRng.Row Then

, так какпервая строка сравнивает значения (это не то, что вы хотите сделать, поскольку оно всегда будет иметь значение True). Вы действительно хотите сравнить номера строк.

В другом примечании следующий фрагмент кода не работает: 

If UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
    Range("X" & cel.Row).Value = "X"
ElseIf UCase(oFoundRng.Offset(0, 1).Value) = "ISAAC" Then
    Range("W" & cel.Row).Value = "X"

Этот ElseIf никогда не будет запущен, так как условие одинаковокак начальное If условие.

Вам также не нужны оба этих утверждения: 

Set oFoundRng = Nothing
Exit Do

Они оба достигают одного и того же (прерывая цикл), Exit Do делаетэто эффективнее.

...