Worksheetfunction.find больше значений не найти

Question

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

Этот процесс работает до тех пор, пока не дойдет до самого последнего слова в ячейке.Поскольку больше нет мест для поиска, возвращается ошибка.Я пытался бороться с этой ошибкой с помощью команды application.find, но когда я это делаю, она рассматривает все как ошибку и просто выделяет весь текст в ячейке.

Что мне интересно, так это:

• Есть ли способ обойти проблему отсутствия пробела между последним пробелом и концом ячейки с помощью команды worksheetfunction.find?
• Что делает application.findкоманда возвращает ошибку (менее важно)?

Dim a As Double
Dim b As Double
Dim c As Variant
Dim d As Integer
Dim e As String
Dim f As Double
Dim g As Variant
Dim h As Variant
Dim i As Integer

a = 1
f = 2
i = 1
b = Len(Cells(i, 1))

While Cells(i, 1) <> vbNullString
    While a < b

        c = vbNullString
        d = 0
        e = vbNullString

        c = WorksheetFunction.Find(Chr(32), Cells(i, 1), a)

        If Not IsError(c) Then

            d = c - a

        ElseIf IsError(c) Then

            d = b - a

        End If

        e = Mid(Cells(1, 1), a, d)

        If Left(e, 4) = "true" Then
            e = "'" & e

        ElseIf Left(e, 5) = "false" Then
            e = "'" & e

        End If


        If e <> vbNullString Then
            Worksheets("Words").Cells(f, 1) = WorksheetFunction.Trim(e)
            f = f + 1

        End If

        If Not IsError(c) Then
            a = c + 1
        Else
            a = a + d
        End If

    Wend
    i = i + 1
    b = Len(Cells(i, 1))
    a = 1
Wend

Answer 1

Попробуйте это решение: оберните Find в On Error Resume Next, тогда, если ваш возвращаемый результат будет пустой строкой, он будет соответствовать вашим Else критериям, и вы можете получить последнее слово в ячейке:

РЕДАКТИРОВАТЬ: После дальнейшего тестирования, это, кажется, немного облажался при переходе к следующему ряду ... Но работало ли это раньше?

Dim a As Double
Dim b As Double
Dim c As Variant
Dim d As Integer
Dim e As String
Dim f As Double
Dim g As Variant
Dim h As Variant
Dim i As Integer

a = 1
f = 2
i = 1
b = Len(Cells(i, 1))

While Cells(i, 1) <> vbNullString
    While a < b

        c = vbNullString
        d = 0
        e = vbNullString

        On Error Resume Next
        c = WorksheetFunction.Find(Chr(32), Cells(i, 1), a)
        On Error GoTo 0

        If c <> "" Then

            d = c - a

        Else

            d = b - a + 1

        End If

        e = Mid(Cells(1, 1), a, d)

        If Left(e, 4) = "true" Then
            e = "'" & e

        ElseIf Left(e, 5) = "false" Then
            e = "'" & e

        End If


        If e <> vbNullString Then
            Worksheets("Words").Cells(f, 1) = WorksheetFunction.Trim(e)
            f = f + 1
        End If

        If c <> "" Then
            a = c + 1
        Else
            a = a + d
        End If

    Wend
    i = i + 1
    b = Len(Cells(i, 1))
    a = 1
Wend

Вот как бы я это сделал, если бы писал с нуля.Используя Split, мы можем отделить значение ячейки по определенному разделителю (в нашем случае это пробел), а затем записать все эти символы по назначению:

Option Explicit
Sub Test()

Dim sht As Worksheet
Dim i As Long, j As Long, k As Long
Dim temparr As Variant

Set sht = ActiveSheet
k = 1

For i = 1 To sht.Cells(sht.Rows.Count, 1).End(xlUp).Row
    temparr = Split(sht.Cells(i, 1).Value, " ")
    For j = 0 To UBound(temparr)
        Sheets("Words").Cells(k, 1).Value = temparr(j)
        k = k + 1
    Next j
Next i

End Sub