VBA代码过滤一列，然后填写另一列中可见单元格的公式

I'm quite new to macros but I'm trying to filter column AW then type in text that corresponds to that criteria in column AZ. Of course I'd like to fill down that text to the visible cells then repeat the process using other criteria filtered in column AZ. I'm using the below coding but it doesn't fill down column AZ, only in AZ2! I don't want the headers affected. Appreciate any help here! -Amy

我对宏很新,但我正在尝试过滤列AW,然后键入与AZ列中的条件相对应的文本。当然,我想将该文本填充到可见单元格,然后使用在AZ列中过滤的其他条件重复该过程。我正在使用以下编码,但它没有填充列AZ,仅在AZ2中!我不希望标题受到影响。感谢任何帮助! -Amy

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

2 个解决方案

#1

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: updated and reworked a bit...

编辑:更新并重新修改了一下......

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

#2

Deconstructing the Range.AutoFilter Method and processing strictly within in-memory arrays should speed this process up.

解构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

^{Elapsed time for 250K rows of random data where 75% of the values in column AW would find a match: 2.06 seconds.}_{Running the same data through a looped .AutoFilter Method equivalent (with the same environment properties disabled) took 24.25 seconds.}

250K行随机数据的经过时间,其中AW列中75%的值将找到匹配:2.06秒。通过循环.AutoFilter方法等效(运行相同的环境属性)运行相同的数据需要24.25秒。