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

我是相当新的macros,但我想过滤列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 

 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 

编辑:更新和重做了一下…

 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 

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

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