VBA 代码过滤一列，然后为另一列中的可见单元格填充公式
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/14776824/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
VBA Code filtering a column then filling down a formula for visible cells in another column
提问by Amy M
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 中！我不希望标题受到影响。感谢这里的任何帮助！-艾米
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
回答by Tim Williams
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
回答by Tim Williams
Deconstructing the Range.AutoFilter Methodand 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 Methodequivalent (with the same environment properties disabled) took 24.25 seconds.
250K 行随机数据的经过时间，其中 AW 列中 75% 的值会找到匹配项：2.06 秒。通过循环的.AutoFilter等效方法（禁用相同的环境属性）运行相同的数据需要 24.25 秒。
