.Indindxt не соблюдая установленный диапазон - PullRequest
Новая
       18

.Indindxt не соблюдая установленный диапазон

0 голосов
/ 03 июля 2018

В моем коде я использую два экземпляра .Find в сочетании с .FindNext. Который, как известно, подвержен ошибкам, к сожалению, я не исключение. Однако это лучшее, что я мог придумать. Код ниже, где я удалил самые несущественные вещи.

Проблема в том, что существуют дублирующие значения, которые я хочу сохранить оба, поэтому я решил использовать .Findnext, если есть дубликат, используя: 

If newqst = refqst Then
    Set newqstadrs = Findrange.FindNext(after:=lstqstadrs)
Else

Проблема здесь в том, что .FindNext не учитывает, что он должен продолжаться на Findrange.Find, но продолжается на FindRangeTwo.Find, используемом здесь: 

newrowtwo = FindRangeTwo.Find(rCell.Value, LookIn:=xlValues, lookat:=xlWhole).row

Полный код: 

For o = 72 To lastrow 

    Dim refqst As String
    refqst = wss.Cells(o, 1).Value
    If Not refqst = "" Then
        If InStr(refqst, ".") > 0 Then
            Dim Findrange As Range
            Dim newqst As String
            Dim newqstadrs As Range
            Dim lstqstadrs As Range

            If newqst = refqst Then
                Set newqstadrs = Findrange.FindNext(after:=lstqstadrs)
            Else

                Select Case Left(refqst, 1)
                    Case 1
                        Set Findrange = wsa.Range(wsa.Cells(4, gewaskolom), wsa.Cells(11, gewaskolom))
                    'some more cases here
                End Select
                Set newqstadrs = Findrange.Find(refqst, LookIn:=xlValues, lookat:=xlWhole)
            End If

            If newqstadrs Is Nothing Then
            Else
                newqst = newqstadrs.Value
                Dim newrow As Long
                newrow = Findrange.Find(refqst, LookIn:=xlValues, lookat:=xlWhole).row
                Dim lstqst As String

                If Not wsa.Cells(newrow, 1) = "" Then
                    'do some stuff         
                    lstqst = refqst
                    Set lstqstadrs = newqstadrs

                ElseIf Not wsa.Cells(newrow, 2) = "" Then

                    Dim FindRangeTwo As Range
                    Set FindRangeTwo = wsa.Range(wsa.Cells(newrow, gewaskolom), wsa.Cells(wsa.Range("B" & newrow).End(xlDown).row, gewaskolom))
                    Dim SearchRange As Range
                    Set SearchRange = wss.Range(wss.Cells(o + 1, 1), wss.Cells(wss.Range("B" & o).End(xlDown).row, 1))
                    Dim rCell As Range
                    For Each rCell In SearchRange
                        Dim newrowtwo As Long
                        newrowtwo = FindRangeTwo.Find(rCell.Value, LookIn:=xlValues, lookat:=xlWhole).row
                        'do some more stuff
                    Next rCell
                    lstqst = refqst
                    Set lstqstadrs = newqstadrs
                End If
            End If            

        End If
    End If
Next o

1 Ответ

0 голосов
/ 03 июля 2018

Вы можете иметь только одну пару Find / FindNext. Второе перекрывает первое. Вам нужен альтернативный метод для FindRangeTwo. Учитывая, что FindRangeTwo представляет собой один столбец (gewaskolom), и вы ищете строку, application.match должен работать хорошо.

Как то так, 

dim newrowtwo as variant   '<~~ should be variant type for IsError to catch

...
newrowtwo = application.match(rCell.Value, FindRangeTwo, 0)
if not iserror(newrowtwo) then
    ...
end if
...

Обратите внимание, что application.match возвращает позицию в FindRangeTwo, а не строку на рабочем листе. Фактическая строка на листе будет (newrowtwo + newrow - 1).

...