VBA Looping & Filtering Issue - PullRequest
       2

VBA Looping & Filtering Issue

0 голосов
/ 14 сентября 2018

У меня проблема с циклическим переключением вкладок в моей книге.Код, над которым я работаю, должен выполнять следующее:

  • Цикл по всем рабочим листам, кроме названных "BOAT" и "Data"
  • Выберите ячейку "A2" (A2содержит значение для фильтрации) в каждом циклическом рабочем листе и использует его в качестве значения автофильтра для вкладки «Данные»
  • Затем скопируйте и вставьте отфильтрованные данные в соответствующую циклическую вкладку.

Проблема, с которой я сталкиваюсь, заключается в том, что мой код не отображается на активном листе в цикле.Есть ли способ создать переменную для рабочего листа, который в данный момент проходит?

Код ниже.Спасибо!

  Sub updatedata()
Dim ws As Worksheet
Dim wsheet2 As Worksheet

For Each ws In ActiveWorkbook.Worksheets
    If ws.name <> "BOAT" And ws.name <> "Data" Then

        Call filter1

    End If
    Next ws


End Sub

Sub filter1()

Dim lastrow As Long
Dim lastrow2 As Long
Dim wSheet As Worksheet
Dim rInput As String

Application.DisplayAlerts = False

Set wSheet = ActiveSheet
rInput = wSheet.Range("A2").Value

Sheets("Data").Activate
lastrow = Range("A" & Rows.Count).End(xlUp).Row
ActiveSheet.Range("A1:Y" & lastrow).AutoFilter field:=4, Criteria1:="=*" & rInput & "*"

lastrow2 = Range("G" & Rows.Count).End(xlUp).Row
Range("G1:G" & lastrow2).Copy
wSheet.Activate
Range("A4").PasteSpecial xlPasteValues
Rows(4).EntireRow.Delete

Application.DisplayAlerts = True

End Sub

1 Ответ

0 голосов
/ 14 сентября 2018

"Есть ли способ создать переменную для листа, который в данный момент проходит по циклу?"

Да, используя переменную Worksheet в качестве аргумента в filter1. Избегайте использования Activate или совершения Range вызовов без указания Worksheet.

Sub updateData()
    Dim ws As Worksheet

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> "BOAT" And ws.Name <> "Data" Then
            filter1 ws 'no need to use Call
        End If
    Next ws
End Sub

Передав ws в качестве аргумента filter1, все вызовы Range полностью квалифицируются с помощью рассматриваемого Worksheet. Это легко сделать с помощью блока With...End With - запишите период . перед .Range("A2").Value, .Range("A4") и т. Д. - эквивалентно myWs.Range("A2").Value, myWs.Range("A4")... и т. Д.

Sub filter1(myWs As Worksheet)
    Dim lastRow As Long, lastRow2 As Long
    Dim rInput As String

    Application.DisplayAlerts = False

    With myWs
        rInput = .Range("A2").Value

        With .Parent.Sheets("Data")
            lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
            .Range("A1:Y" & lastRow).AutoFilter field:=4, Criteria1:="=*" & rInput & "*"
            lastRow2 = .Range("G" & .Rows.Count).End(xlUp).Row
            .Range("G1:G" & lastRow2).Copy
        End With

        .Range("A4").PasteSpecial xlPasteValues
        .Rows(4).EntireRow.Delete
    End With

    Application.DisplayAlerts = True

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