Код VBA фильтрует столбец, а затем заполняет формулу для видимых ячеек в другом столбце

Я новичок в макросах, но я пытаюсь отфильтровать столбец AW, а затем ввести текст, соответствующий этому критерию, в столбце AZ. Конечно, я хотел бы заполнить этот текст видимыми ячейками, а затем повторить процесс, используя другие критерии, отфильтрованные в столбце AZ. Я использую приведенную ниже кодировку, но она не заполняет столбец AZ, только в AZ2! Я не хочу, чтобы заголовки были затронуты. Оцените любую помощь здесь! -Эми

Sub Macro16()

' Macro16 Macro

'Insert Column - OK
Columns("AZ:AZ").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("AZ1").Select
ActiveCell.FormulaR1C1 = "Finalized Comment"
Rows("1:1").Select
Range("AS1").Activate
Selection.AutoFilter


'Filter Combined Comment for #NA then type "Style linked to a Dropped T/P"


 Dim lastRow As Long

 With ActiveSheet
    .Range("AW2").AutoFilter Field:=2, Criteria1:="#N/A"
    lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
    .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
           SpecialCells(xlCellTypeVisible).Value = _
                     "Style Linked to a Dropped T/P"
 End With

'Filter Combined Comment for "Confirmed Cost and Missing HTS Code" then =Combined Comment

 Dim lastRow As Long

 With ActiveSheet
    .Range("AW2").AutoFilter Field:=2, Criteria1:="Confirmed Cost and Missing HTS Code"
    lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
    .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
           SpecialCells(xlCellTypeVisible).Value = _
                     "Confirmed Cost and Missing HTS Code"
 End With


'Filter Combined Comment for "Unconfirmed Cost and HTS Code Present" then =Unconfirmed Cost

 Dim lastRow As Long

 With ActiveSheet
    .Range("AW2").AutoFilter Field:=2, Criteria1:="Unconfirmed Cost and HTS Code Present"
    lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
    .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
           SpecialCells(xlCellTypeVisible).Value = _
                     "Unconfirmed Cost"
 End With

 'Filter Combined Comment for "Unconfirmed Cost and Missing HTS Code" then =Missing HTS

 Dim lastRow As Long

 With ActiveSheet
    .Range("AW2").AutoFilter Field:=2, Criteria1:="Unconfirmed Cost and Missing HTS Code"
    lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
    .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
           SpecialCells(xlCellTypeVisible).Value = _
                     "Missing HTS Code"
 End With




 End Sub

person Amy M    schedule 08.02.2013    source источник


Ответы (2)


Sub Tester()
Dim lastRow As Long

    With ActiveSheet
        .Range("AW2").AutoFilter Field:=2, Criteria1:="Test"
        lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
        .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
               SpecialCells(xlCellTypeVisible).Value = _
                         "Style Linked to a Dropped T/P"
    End With

End Sub

EDIT: немного обновлен и переработан...

Sub Macro16()

Dim lastRow As Long

    'Insert Column - OK
    ActiveSheet.Columns("AZ:AZ").Insert Shift:=xlToRight, _
                       CopyOrigin:=xlFormatFromLeftOrAbove
    Range("AZ1").Value = "Finalized Comment"

    TagRows "#N/A", "Style Linked to a Dropped T/P"
    TagRows "Confirmed Cost and Missing HTS Code", _
            "Confirmed Cost and Missing HTS Code"
    TagRows "Unconfirmed Cost and HTS Code Present", "Unconfirmed Cost"
    TagRows "Unconfirmed Cost and Missing HTS Code", "Missing HTS Code"

End Sub

Sub TagRows(TextToFind As String, TagWithText As String)
    Dim lastRow As Long
    With ActiveSheet
        'filter the column for "TextToFind"
        .Range("AW:AW").AutoFilter Field:=1, Criteria1:=TextToFind
        'find the last row
        lastRow = .Range("AW" & Rows.Count).End(xlUp).Row
        'if any visible rows, fill in the new comment "TagWithText"
        If lastRow > 2 Then
            .Range(.Range("AZ2"), .Range("AZ" & lastRow)). _
               SpecialCells(xlCellTypeVisible).Value = TagWithText
        End If
        .Range("AW:AW").AutoFilter Field:=1 'clear the filter
    End With
End Sub
person Tim Williams    schedule 08.02.2013
comment
Большое спасибо! Работал как во сне. :-) - person Amy M; 08.02.2013
comment
Тим. Когда я снова пытаюсь использовать этот код для других трех критериев в столбце AZ, я получаю выделенную ошибку «Дубликат объявления в текущей области видимости» (lastRow As Long). - person Amy M; 08.02.2013
comment
Я предполагаю, что вы продублировали строку Dim lastRow As Long - вам это нужно только один раз. - person Tim Williams; 08.02.2013
comment
Я обновил его и да, я продублировал Dim lastRow As Long для каждого фильтра столбца AW. Извините, я не знал, что мне это нужно только один раз. Не могли бы вы изменить мой код, чтобы я знал место размещения? Я очень ценю вашу помощь! - person Amy M; 08.02.2013
comment
Большое спасибо за вашу помощь. Я так рад, что это, наконец, исправлено!! - person Amy M; 09.02.2013

Деконструкция метода Range.AutoFilter и обработка строго в оперативной памяти массивы должны ускорить этот процесс.

Option Explicit

Sub tagAZ()
    Dim t As Variant, vFNDs As Variant, vTAGs As Variant
    Dim a As Long, vAWs As Variant, vAZs As Variant

    appTGGL bTGGL:=False

    vFNDs = Array("#N/A", "Confirmed Cost and Missing HTS Code", _
                  "Unconfirmed Cost and HTS Code Present", _
                  "Unconfirmed Cost and Missing HTS Code")
    vTAGs = Array("Style Linked to a Dropped T/P", "Confirmed Cost and Missing HTS Code", _
                  "Unconfirmed Cost", "Missing HTS Code")

    With Worksheets("Sheet1")
        .Columns(52).Insert
        .Cells(1, 52) = "tag comment"
        .Columns(52).ColumnWidth = 32
        With .Range(.Cells(2, 49), .Cells(Rows.Count, 49).End(xlUp))
            vAWs = .Cells.Value2
            ReDim vAZs(LBound(vAWs, 1) To UBound(vAWs, 1), 1 To 1)

            For a = LBound(vAWs, 1) To UBound(vAWs, 1)
                Select Case True
                    'catch True errors
                    Case IsError(vAWs(a, 1))
                        If vAWs(a, 1) = CVErr(xlErrNA) Then _
                            vAZs(a, 1) = vTAGs(0)
                    'catch text-that-looks-like-an-error
                    Case vAWs(a, 1) = vFNDs(0)
                        vAZs(a, 1) = vTAGs(0)
                    'catch the rest
                    Case vAWs(a, 1) = vFNDs(1)
                        vAZs(a, 1) = vTAGs(1)
                    Case vAWs(a, 1) = vFNDs(2)
                        vAZs(a, 1) = vTAGs(2)
                    Case vAWs(a, 1) = vFNDs(3)
                        vAZs(a, 1) = vTAGs(3)
                End Select
            Next a

        End With

        'return processed tag comments to the worksheet
        .Cells(2, 52).Resize(UBound(vAZs, 1), UBound(vAZs, 2)) = vAZs
    End With

    appTGGL

End Sub

Public Sub appTGGL(Optional bTGGL As Boolean = True)
    Debug.Print Timer
    With Application
        .ScreenUpdating = bTGGL
        .EnableEvents = bTGGL
        .DisplayAlerts = bTGGL
        .Calculation = IIf(bTGGL, xlCalculationAutomatic, xlCalculationManual)
    End With
End Sub

Время, затраченное на 250 тыс. строк случайных данных, где 75 % значений в столбце AW найдут совпадение: 2,06 секунды. Прогон одних и тех же данных через зацикленный .AutoFilter (с отключенными теми же свойствами среды) занял 24,25 секунды.

person Community    schedule 11.03.2016