Невозможно получить свойство FindNext класса range - PullRequest
2 голосов
/ 02 марта 2020

У меня есть этот код, он просто берет 3 слова от пользователя, ищет слова в b, c и d и меняет значение на XXXXXXXXXXXXX.

Проблема в том, что я

не могу получить свойство findnext класса диапазона

Мне нужен этот код для многократного поиска с разными словами и заменить значения без закрытия / сброса Excel. И если это возможно, когда он не находит значение в b, следует go и выполнить следующий фрагмент кода.

Код ищет слова в абзацах.

Может кто-нибудь, пожалуйста, укажите мне в правильном направлении?

Private Sub CommandButton1_Click()

Dim x As String
Dim y As String
Dim z As String

x = InputBox("enter word")
y = InputBox("enter word")
z = InputBox("enter word")





With Worksheets(1).Range("b2:b1000")
    Set b = Cells.Find(x)
    If Not b Is Nothing Then
        firstAddress = b.Address
        Do

             b.Value = "XXXXXXXXXXXXX"
             Set b = .FindNext(b)
        Loop While Not b Is Nothing
    End If
End With


With Worksheets(1).Range("c2:c1000")
    Set c = Cells.Find(y)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do
            c.Value = "XXXXXXXXXXXXX"
            Set c = .FindNext(c)
        Loop While Not c Is Nothing
    End If
End With


With Worksheets(1).Range("d2:d1000")
    Set d = Cells.Find(z)
    If Not d Is Nothing Then
        firstAddress = d.Address
        Do
            d.Value = "XXXXXXXXXXXXX"
            Set d = .FindNext(d)
        Loop While Not d Is Nothing
    End If
End With

End Sub

Ответы [ 2 ]

1 голос
/ 02 марта 2020

Протестировал этот код, и если у меня есть ячейка с: "Nombre del producto: wok antiadherente verde // Материал: Металл // Tamaño: vista general del dibujo // Capacidad: 2500 / 4200ml" и я Я ищу слово "Verde", оно заменяет только слово, а остальная часть текста все еще там. - Эндрю См 9 минут go

Option Explicit

Private Sub CommandButton1_Click()
    Dim ws As Worksheet
    Dim firstWord As String
    Dim secondWord As String
    Dim thirdWord As String

    On Error GoTo Whoa

    '~~> Change this to the relevant worksheet
    Set ws = Sheet1

    firstWord = InputBox("enter word")
    secondWord = InputBox("enter word")
    thirdWord = InputBox("enter word")

    With ws
        If firstWord <> "" Then ReplaceText ws.Range("B2:B1000"), firstWord
        If secondWord <> "" Then ReplaceText ws.Range("C2:C1000"), secondWord
        If thirdWord <> "" Then ReplaceText ws.Range("D2:D1000"), thirdWord
    End With

    Exit Sub
Whoa:
    MsgBox Err.Description
End Sub

'~~> Identify the cell where the value is found and
'~~> Store it in a range. at the end, directly
'~~> replace all values
Private Sub ReplaceText(rng As Range, txt As String)
    Dim aCell As Range, bCell As Range
    Dim rngFound As Range

    Set aCell = rng.Find(What:=txt, LookIn:=xlValues, _
                LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                MatchCase:=False, SearchFormat:=False)

    If Not aCell Is Nothing Then
        Set bCell = aCell
        Set rngFound = aCell

        Do
            Set aCell = rng.FindNext(After:=aCell)

            If Not aCell Is Nothing Then
                If aCell.Address = bCell.Address Then Exit Do
                Set rngFound = Union(rngFound, aCell)
            Else
                Exit Do
            End If
        Loop
    End If

    If Not rngFound Is Nothing Then
        rngFound.Value = "XXXXXXXXXXXXX"
    End If
End Sub
0 голосов
/ 02 марта 2020

Ваш случай будет легче решить, если VBA / VB6 будет поддерживать Try/Catch. Однако это не так. Поэтому мы возвращаемся к самому близкому из возможных: On Error Resume Next и On Error Goto 0.

On Error Resume Next позволят возникать ошибкам и заполнят глобальный объект Err номером ошибки в библиотеке VB. , Просто установите его в 0, прежде чем проверять наличие новых ошибок, потому что On Error Resume Next не очищает его значение.

...

Do
  Err = 0   'reset it /ignore any old value
  b.Value = "XXXXXXXXXXXXX"
  On Error Resume Next
  Set b = .FindNext(b)
  On Error Goto 0
Loop While Not b Is Nothing And Err = 0   ' stay in the loop if there are no errors 
...
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...