我花了很长时间才让 AutoFilter 条件应用，包括过滤和排序。我想摆脱空白行并过滤多个条件 - 很简单，对吧？但它不起作用。我觉得我已经尝试了网上的所有技巧。为了摆脱空白，我甚至尝试过遍历每一行，如果行中的第一个单元格为空白（或“”，或 TRIM(“”) 等），则删除该行 - 它真的很慢，而且仍然不起作用。我尝试使用 Range.Sort 方法，据我所知，它的工作方式与 AutoFilter.Sort 方法几乎相同，只是当您点击种类菜单按钮。尝试的过滤和排序方法要么隐藏整个排序/过滤范围，要么不隐藏任何范围。使用以下代码，可以通过过滤器下拉菜单和排序按钮验证 AutoFilter 和 AutoFilter.Sort 标准是否已正确设置，但整个排序/过滤范围 (A1:O5000) 被隐藏，列表未排序。录制手动启用其中一个或两个的宏会显示与我使用的完全相同的代码结构。
您知道问题是什么吗？
我的代码依赖于另一个工作簿（维护记录.xlsx)，因此我将其都上传到了此处：
- http://tyblu.ca/misc/exceltrouble/DRAFT2%20maint-print.xlsm
- [链接已删除 - 私人信息]
VBA：
Option Explicit ' checks variables
' Module-level variables
Dim Date_str, Name_str, Unit_str, Work_str, Impo_str, Kilo_str, Hour_str, Reso_str, Note_str As String
Dim Date_fmt, Name_fmt, Unit_fmt, Work_fmt, Impo_fmt, Kilo_fmt, Hour_fmt, Reso_fmt, Note_fmt As String
Dim Date_wid, Name_wid, Unit_wid, Work_wid, Impo_wid, Kilo_wid, Hour_wid, Reso_wid, Note_wid As Integer
Dim Date_col, Name_col, Unit_col, Work_col, Impo_col, Kilo_col, Hour_col, Reso_col, Note_col As Variant
Dim Range_ary, Ranges_ary As Variant
Dim Head_str As String, Head_fmt As String, Head_hgt As Integer
Dim CurrentWorksheet As Worksheet
Public Sub FormatAllSheets()
'
' FormatAllSheets Macro
'
' Recreates all worksheets.
' Formats column widths, data types, and freezes top row on all sheets except "rules".
'
Application.ScreenUpdating = False ' turn off screen updates
' Save current sheet and cell selection so we can go back to it when finished
Dim ActSheet_str As String, ActRange_str As String
ActSheet_str = ActiveSheet.Name
ActRange_str = Selection.Address
' Delete existing sheets, except "rules"
ThisWorkbook.Sheets("rules").Activate
Application.DisplayAlerts = False ' turn off notifications
For Each CurrentWorksheet In Worksheets
If CurrentWorksheet.Name <> "rules" Then CurrentWorksheet.Delete
Next CurrentWorksheet
Application.DisplayAlerts = True ' turn on notifications
' Clear "rules", reset formulas
Worksheets("rules").Range("A1:Z100").Delete
Worksheets("rules").Range("A1:Z100").Formula = "=IF(ISBLANK(" & Chr(39) & "[maintenance-record.xlsx]rules" & Chr(39) & "!A1)," & Chr(34) & Chr(34) & "," & Chr(39) & "[maintenance-record.xlsx]rules" & Chr(39) & "!A1)"
' Create all sheets (blank), except "rules"
ThisWorkbook.Sheets.Add.Name = "orig"
ThisWorkbook.Sheets.Add.Name = "ALL"
ThisWorkbook.Sheets.Add.Name = "CRIT"
ThisWorkbook.Sheets.Add.Name = "NEW"
' Set font style Normal so subsequent character width actions are consistent
With ThisWorkbook.Styles("Normal")
.Font.Name = "Calibri"
.Font.Size = "11"
End With
' LOOP THROUGH EACH SHEET, except "rules"
Call SetColumnData
For Each CurrentWorksheet In Worksheets
If CurrentWorksheet.Name <> "rules" Then
CurrentWorksheet.Activate
With CurrentWorksheet ' set column formats and widths
For Each Range_ary In Ranges_ary
Range(Range_ary(0)).NumberFormat = Range_ary(1)
Range(Range_ary(0)).ColumnWidth = Range_ary(2)
Next Range_ary
Range(Head_str).RowHeight = Head_hgt ' set headings height
Range(Head_str).Font.Bold = True ' set headings bold
Range("E1,F1,J1,N1").Orientation = xlUpward ' set some headings 90-deg
' Set the equations for all cells here, calling the various ranges (Select Case...)
Dim Formula_str As String
Select Case CurrentWorksheet.Name
Case Is = "orig"
Formula_str = "=IF(ISBLANK(" & Chr(39) & "[maintenance-record.xlsx]Sheet1" & Chr(39) & "!A1)," & Chr(34) & Chr(34) & "," & Chr(39) & "[maintenance-record.xlsx]Sheet1" & Chr(39) & "!A1)"
Case Is = "rules"
MsgBox "We shouldn't be iterating through 'rules'!!"
Case Is = "NEW"
Formula_str = "=IF(ROW(orig!A1)=1,orig!A1,IF(OR(ISERROR(orig!$A1),ISBLANK(orig!$A1),orig!$A1=" & Chr(34) & Chr(34) & ",orig!$J1=" & Chr(34) & "Y" & Chr(34) & "), TRIM(" & Chr(34) & Chr(34) & "),IF((TODAY()-orig!$A1)<rules!$B$9,orig!A1, TRIM(" & Chr(34) & Chr(34) & "))))"
Case Is = "CRIT"
Formula_str = "=IF(ROW(orig!A1)=1,orig!A1,IF(OR(ISERROR(orig!$A1),ISBLANK(orig!$A1),orig!$A1=" & Chr(34) & Chr(34) & ",orig!$J1=" & Chr(34) & "Y" & Chr(34) & "), TRIM(" & Chr(34) & Chr(34) & "),IF(OR(AND(orig!$N1=" & Chr(34) & "HIGH" & Chr(34) & ",(TODAY()-orig!$A1)>rules!$B$6),AND(orig!$N1=" & Chr(34) & "MED" & Chr(34) & ",(TODAY()-orig!$A1)>rules!$B$5),AND(orig!$N1=" & Chr(34) & "LOW" & Chr(34) & ",(TODAY()-orig!$A1)>rules!$B$4),AND(orig!$N1=" & Chr(34) & "WAIT" & Chr(34) & ",(TODAY()-orig!$A1)>rules!$B$3)),orig!A1, TRIM(" & Chr(34) & Chr(34) & "))))"
Case Is = "ALL"
Formula_str = "=IF(ROW(orig!A1)=1,orig!A1,IF(OR(ISERROR(orig!$A1),ISBLANK(orig!$A1),orig!$A1=" & Chr(34) & Chr(34) & ",orig!$J1=" & Chr(34) & "Y" & Chr(34) & "), TRIM(" & Chr(34) & Chr(34) & "),orig!A1))"
Case Else
Formula_str = ""
End Select
Range("A1:O5000").Formula = Formula_str
' Set headings text
Range("A1:O1").Value = Array( _
"report date", _
"reported by", _
"unit", _
"work required / work completed", _
"importance - original", _
"importance - supervisor", _
"work date", _
"kilometers", _
"hours", _
"Resolved?", _
"assigned to", _
"Shop Manager review date", _
"notes", _
"importance - overall", _
"importance - numeric" _
)
' Format all cells except the headings
With Range("A2:O5000")
.WrapText = True
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.ReadingOrder = xlContext
.MergeCells = False
.Rows.AutoFit
.VerticalAlignment = xlBottom
End With
' Set custom sorting for each page, except "rules"
' .AutoFilter.Sort.SortFields.Clear
' .Sort.SortFields.Clear
' .Sort.SetRange Range("A1:O5000")
' Select Case CurrentWorksheet.Name
' Case Is = "NEW"
' .Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("B2:B5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' Case Is = "CRIT"
' .Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' Case Is = "ALL"
' .Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' .Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
' End Select
' .Sort.Header = xlYes
' .Sort.MatchCase = False
' .Sort.Orientation = xlTopToBottom
' .Sort.SortMethod = xlPinYin
' .Sort.Apply
' ' Set custom sorting for each page, except "rules", using AutoFilter
.AutoFilterMode = False ' clear previous filters... shouldn't make a difference
.Range("A1:O1").AutoFilter
If .Name = "NEW" Then
.AutoFilter.Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("B2:B5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ElseIf .Name = "CRIT" Then
.AutoFilter.Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
ElseIf .Name = "ALL" Then
.AutoFilter.Sort.SortFields.Add Key:=Range("C2:C5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("O2:O5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.AutoFilter.Sort.SortFields.Add Key:=Range("A2:A5000"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
Else
End If
.AutoFilter.Sort.Header = xlYes
.AutoFilter.Sort.MatchCase = False
.AutoFilter.Sort.Orientation = xlTopToBottom
.AutoFilter.Sort.SortMethod = xlPinYin
.AutoFilter.Sort.Apply
' Filter out blank rows for each page, except "rules"
.Range("A1:O1").AutoFilter Field:=1, Criteria1:="<>"
End With
End If
Next CurrentWorksheet
Application.ScreenUpdating = True ' turn on screen updates
' Go back to the original sheet and selection
Worksheets(ActSheet_str).Activate
Worksheets(ActSheet_str).Range(ActRange_str).Select
MsgBox "Finished."
End Sub
Sub SetColumnData()
'Define column formats and ranges for all sheets, except "rules"
Date_str = "A:A,G:G,L:L" ' column range
Date_fmt = "[$-409]mmmm d, yyyy;@" ' custom number format
Date_wid = 19 ' width in characters (zeroes in font style Normal)
Name_str = "B:B,K:K"
Name_fmt = "@"
Name_wid = 18
Unit_str = "C:C"
Unit_wid = 6
Work_str = "D:D"
Work_wid = 66
Impo_str = "E:E,F:F,N:N"
Impo_wid = 5
Kilo_str = "H:H"
Kilo_wid = 10
Hour_str = "I:I"
Hour_wid = 9
Reso_str = "J:J"
Reso_wid = 4
Note_str = "M:M"
Note_wid = 50
Head_str = "A1:N1"
Head_hgt = 120
Date_col = Array(Date_str, Date_fmt, Date_wid)
Name_col = Array(Name_str, Name_fmt, Name_wid)
Unit_col = Array(Unit_str, Unit_fmt, Unit_wid)
Work_col = Array(Work_str, Work_fmt, Work_wid)
Impo_col = Array(Impo_str, Impo_fmt, Impo_wid)
Kilo_col = Array(Kilo_str, Kilo_fmt, Kilo_wid)
Hour_col = Array(Hour_str, Hour_fmt, Hour_wid)
Reso_col = Array(Reso_str, Reso_fmt, Reso_wid)
Note_col = Array(Note_str, Note_fmt, Note_wid)
Ranges_ary = Array(Date_col, Name_col, Unit_col, Work_col, Impo_col, Kilo_col, Hour_col, Reso_col, Note_col)
End Sub
如果您好奇的话，这是我为一家小型吊车和运输公司开发的维护跟踪系统。这些表格需要防篡改，因为每天有多达十几个计算机新手使用它们，所以我将格式、过滤、排序和方程式硬编码到隐藏的 vba 脚本中。它远非完美，但基本上可以正常工作。我只是一名主管，确实需要解决被忽视的设备问题。