Метод 'Range' объекта'_Worksheet 'не выполнен | Excel | VBA | - PullRequest
0 голосов
/ 28 мая 2019

Ошибка: метод 'Range' объекта'_Worksheet 'не выполнен

Dim Ws As Worksheet
For Each Ws In Sheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))

    Ws.Range("I9:AM68" & Rows.Count).Replace What:="AP", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="BL", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="MA", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="PA", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="PL", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="SL", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="UP", Replacement:="", LookAt:=xlWhole

    Ws.Range("I9:AM68" & Rows.Count).Replace What:="H1", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="H2", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="TR", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="WH", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="NJ", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="AL", Replacement:="", LookAt:=xlWhole
    Ws.Range("I9:AM68" & Rows.Count).Replace What:="SUP", Replacement:="", LookAt:=xlWhole

Next Ws

Если на каждом листе найдено совпадение, данные очищаются => имеют условное форматирование в диапазоне => от I до AM

Это мой другой код, который я пробовал не работать

Dim Ws As Worksheet, lr As Long, c As Range
For Each Ws In Sheets(Array("January", "February", "March", "April", "May", "June", "July", "August", "September", "October", "November", "December"))
    lr = Ws.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
    For Each c In Ws.Range("I9:AM68" & lr)
        Select Case UCase(c.Value)
            Case "SUP", "AP", "AL"
                c.Value = ""
                c.Interior.ColorIndex = xlNone
        End Select
    Next
Next Ws

Это изображение моего Excel

[мое изображение] [1]: https://i.stack.imgur.com/yDLj4.png

Это ниже Работает нормально для меня, но не для установки цвета ячейки на нормальный цвет ячейки, как без цвета заливки

'what:=UCase("SUP"), Replacement:="", ReplaceFormat:=True

Dim Ws As Worksheet
For Each Ws In Sheets(Array("Sheet1", "Sheet2", "Sheet3"))

Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("SUP"), Replacement:="", ReplaceFormat:=True
Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("SUP"), Replacement:="", ReplaceFormat:=False

Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("AP"), Replacement:="", ReplaceFormat:=True
Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("AP"), Replacement:="", ReplaceFormat:=False

Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("AL"), Replacement:="", ReplaceFormat:=True
Ws.Range("A4:K" & Rows.Count).Replace what:=UCase("AL"), Replacement:="", ReplaceFormat:=False

Next Ws

это ниже вывода вышеуказанного кода [вывод] [1]: https://i.stack.imgur.com/H09ab.png

1 Ответ

2 голосов
/ 28 мая 2019

Предполагая, что вы пытаетесь получить последнюю строку в этом диапазоне, а не фактическую rows.count, см. Ниже один способ достижения этих замен.

Option Explicit
Sub doSomeReplacements()

    Application.ScreenUpdating = False

    Dim wb As Workbook: Set wb = ThisWorkbook   'set your workbook variable
    Dim Ws As Worksheet
    Dim shNames() As String: shNames = Split("Sheet1,Sheet2,Sheet3", ",") 'allocate sheet names to an array
    Dim strReplaces() As String: strReplaces = Split("AP,BL,MA,PA,PL,SL,UP,H1,H2,TR,WH,NJ,AL,SUP", ",") 'allocate replacement strings to an array
    Dim lastRow As Long, X As Long, Z As Long, R As Long, C As Long

    For X = LBound(shNames) To UBound(shNames)  'Loop through the array of sheet names
        On Error Resume Next
        Set Ws = wb.Sheets(shNames(X))
        On Error GoTo 0

        If Not Ws Is Nothing Then   'If there is a worksheet to work with....
            With Ws
                'lastRow = .Cells(.Rows.Count, "I").End(xlUp).Row   'get last row at column "I"
                lastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row 'alternative last row

                For R = 1 To lastRow
                    For C = 1 To 11 '"A:K"
                        For Z = LBound(strReplaces) To UBound(strReplaces) 'Loop through the array of replacements and apply the replacement
                            With .Cells(R, C)
                                If .Value = strReplaces(Z) Then
                                    .Value = ""
                                    .Interior.ColorIndex = xlNone
                                End If
                            End With
                        Next Z
                    Next C
                Next R
            End With
        End If
        Set Ws = Nothing
    Next X

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