Итак, мне нужно создать макрос Excel в VBA, который будет искать строку, затем сравнивать ее с предварительно заданной строкой по своему выбору, а затем изменять значение ячейки в другом листе.

Это выглядит так:

Sub Macro1()

Dim A As Integer
Dim WS As Worksheet

Dim ToCompare, Coniburo As String

Coniburo = "My String"

For Each WS In Worksheets
    For A = 1 To Rows.Count
    ToCompare = Left(Cells(A, 3), 100)
        If InStr(ToCompare, Coniburo) > 0 Then
            Sheets("Last Sheet").Cells(21, 2).Value = "233"
        End If
    Next A
Next

Макрос работает ....... Если я удаляю первый For (тот, который ищет листы), и пока я в листе, где присутствует "Моя строка". Иначе это не сработает. Обработка занимает много времени, более минуты, так как есть 17 листов.

Почему не работает? Я прочитал много постов здесь, на форуме разработчиков Microsoft, на сайте под названием Tech в сети, и все же кое-что мне не хватает, но я не знаю почему.

Кто-нибудь может указать мне правильное направление?

3
Tato 5 Апр 2017 в 22:08

2 ответа

Лучший ответ

Используйте With ... End With, чтобы сфокусировать родительский лист для каждой итерации цикла.

Option Explicit

Sub Macro1()
    Dim a As Long, Coniburo As String, ws As Worksheet

    Coniburo = "My String"

    For Each ws In Worksheets
        With ws
            For a = 1 To .Cells(.Rows.Count, "C").End(xlUp).Row
                If CBool(InStr(Left(.Cells(a, 3), 100), Coniburo, vbTextCompare)) Then
                    Worksheets("Last Sheet").Cells(21, 2).Value = 233
                End If
            Next a
        End With
    Next

End Sub

Вам нужно добавить префикс Rows, Range и Cells к периоду, например .Rows..., .Range(...) или .Cells(...), когда он находится внутри блока With ... End With. Это идентифицирует их с родительским рабочим листом, описанным с.

Я также сделал сравнение без учета регистра с vbTextCompare.

Остается проблема записи и перезаписи 233 в одну и ту же ячейку на том же рабочем листе, но это другой вопрос.

3
user4039065user4039065 5 Апр 2017 в 19:18

Я немного изменил правила, но хочу показать, как мы могли бы использовать встроенную функцию НАЙТИ, чтобы значительно ускорить процесс. Просто мы проработаем каждый лист только в столбце C; мы используем функцию НАЙТИ, чтобы найти номер строки, где столбец C содержит строку поиска .... тогда мы дважды проверим эту ячейку, чтобы увидеть, находится ли ваша строка поиска в пределах первых 100 символов, согласно вашему требованию. Если это так, мы посчитаем это совпадением. В дополнение к вашему результату «233» на листе «Последняя страница» я включил ярко-зеленую подсветку, чтобы увидеть, что происходит ...

Sub findConiburo()
    Coniburo = "My String"
    For Each ws In Worksheets
        With ws.Range("C:C")
            myName = ws.Name 'useful for debugging

            queue = 1 'will be used to queue the FIND function

            x = 0 'loop counter

            Do 'loop to find multiple results per sheet

                On Error Resume Next 'Disable error handling

                'FIND Coniburo within ws column C, log row number:
                'Note ".Cells(queue, 1)" is a relative reference to the current WS, column C
                foundRow = .Find(What:=Coniburo, After:=.Cells(queue, 1), LookIn:=xlFormulas, LookAt _
                    :=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
                    False, SearchFormat:=False).Row

                'If no result found then an error number is stored. Perform error handling:
                If Err.Number <> 0 Then
                    'No results found, don't do anything, exit DO to skip to next sheet:
                    Exit Do
                End If
                On Error GoTo 0 'Re-enable error handling

                If x = 0 Then
                    'first loop - log the first row result:
                    originalFoundRow = foundRow
                ElseIf foundRow = originalFoundRow Then
                    'Not the first loop. Same result as original loop = we're back at the start, so exit loop:
                    Exit Do
                End If

                'Update queue so next loop will search AFTER the previous result:
                queue = foundRow

                'check if the string is not only SOMEWHERE in the cell,
                'but specifically within the first 100 characters:
                ToCompare = Left(.Cells(foundRow, 1), 100)
                If InStr(ToCompare, Coniburo) > 0 Then
                    .Cells(foundRow, 1).Interior.ColorIndex = 4 'highlight green
                    Sheets("Last Sheet").Cells(21, 2).Value = "233"
                End If

                'Update loop counter:
                x = x + 1
            Loop
        End With
    Next ws
End Sub
1
David 5 Апр 2017 в 20:32