Измените код, чтобы использовать выбор для заполнения массива - PullRequest
0 голосов
/ 26 сентября 2019

У меня есть рабочий код, который делает то, что должен делать.Я просто хотел бы изменить способ заполнения переменной myStrings.

From:

myStrings = Array("Test23", "Test-12", "54-Test")

To:

myStrings = Selection.Value

Если я запускаю это, я получаю ошибку времени выполнения 9;Нижний индекс вне диапазона.

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

Я новичок в VBA, и я объединил это из разных источников, я не могу понять, как исправить эту ошибку.

Я ценю любую помощь или, возможно, даже другое решение, если оно делает то же самое.

Спасибо.

Option Explicit

Sub LoopThroughWorksheets()

Dim sh As Worksheet

For Each sh In ThisWorkbook.Worksheets

Dim calcmode As Long
Dim ViewMode As Long
Dim myStrings As Variant
Dim FoundCell As Range
Dim I As Long
Dim myRng As Range

     Set myRng = sh.Range("A:N")

     myStrings = Array("Test23", "Test-12", "54-Test")

With Application
    calcmode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

       With sh

        .Select

        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView


        .DisplayPageBreaks = False

            With myRng

            For I = LBound(myStrings) To UBound(myStrings)
                Do
                    Set FoundCell = myRng.Find(What:=myStrings(I), _
                                               After:=.Cells(.Cells.Count), _
                                               LookIn:=xlValues, _
                                               LookAt:=xlWhole, _
                                               SearchOrder:=xlByRows, _
                                               SearchDirection:=xlNext, _
                                               MatchCase:=False)
                    If FoundCell Is Nothing Then
                        Exit Do
                    Else
                        FoundCell.EntireRow.Delete
                    End If
                Loop
            Next I

        End With

    End With

With Application
    .ScreenUpdating = True
    .Calculation = calcmode
End With

    ActiveWindow.View = ViewMode

Next sh

MsgBox ("Completed")

End Sub
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...