मैं फ़िल्टरिंग और सॉर्टिंग दोनों को लागू करने के लिए ऑटोफ़िल्टर मानदंड प्राप्त करने के लिए एक समय की एक बिल्ली हो रहा हूं। मैं कई मानदंडों पर रिक्त पंक्तियों और फ़िल्टर से छुटकारा पाने की कोशिश कर रहा हूं - सरल, सही? सिवाय इसके काम नहीं करता। मुझे लगता है कि मैंने नेट पर हर हैक करने की कोशिश की है। रिक्त स्थान से छुटकारा पाने के लिए मैंने प्रत्येक पंक्ति के माध्यम से पुनरावृत्ति की कोशिश की है, पंक्ति को हटाना यदि पंक्ति में पहला सेल रिक्त था (या "", या TRIM (""), आदि) - यह वास्तव में धीमा था, और यह अभी भी काम नहीं किया। मैंने Range.Sort मेथड का उपयोग करने की कोशिश की, जो कि जहां तक मैं बता सकता हूं, ऑटोफ़िल्टर को लगभग पहचानने का काम करता है। सिवाय मेथड सिवाय इसके कि जब आप हिट करते हैं तो यह प्रदर्शित नहीं होता है तरह मेनू बटन। फ़िल्टरिंग और सॉर्टिंग के लिए प्रयास किए गए तरीकों के परिणामस्वरूप या तो संपूर्ण सॉर्ट / फ़िल्टर रेंज को छिपा दिया गया है या उनमें से कोई भी नहीं छिपा रहा है। नीचे दिए गए कोड के साथ, AutoFilter और AutoFilter.Sort मानदंड को फ़िल्टर ड्रॉप-डाउन और सॉर्ट बटन के माध्यम से सत्यापित किया जा सकता है, लेकिन पूरी तरह से / फ़िल्टर रेंज (A1: O5000) छिपी हुई है और सूची क्रमबद्ध नहीं है । मैन्युअल रूप से या तो या दोनों को सक्षम करने के लिए मैक्रो रिकॉर्ड करना ठीक उसी कोड संरचना को दिखाता है जिसका मैं उपयोग कर रहा हूं।
क्या आप देखते हैं कि मुद्दा क्या हो सकता है?
मेरा कोड किसी अन्य कार्यपुस्तिका पर निर्भर करता है ( रखरखाव record.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
यदि आप उत्सुक हैं, तो यह एक रखरखाव ट्रैकिंग प्रणाली है जिसे मैंने एक छोटे बूम ट्रक और परिवहन कंपनी के लिए विकसित किया है। इन शीट्स को टैम्पर प्रूफ होना चाहिए, क्योंकि एक दर्जन से अधिक कंप्यूटर नौसिखिए दैनिक आधार पर इनका इस्तेमाल करते हैं, इसलिए मैंने छिपे हुए वीबीए स्क्रिप्ट में फ़ॉर्मेटिंग, फ़िल्टरिंग, सॉर्टिंग और समीकरणों को हार्ड-कोड किया है। यह एकदम सही है, लेकिन यह ज्यादातर काम करता है। मैं सिर्फ एक पर्यवेक्षक हूं जिसे वास्तव में उपेक्षित उपकरणों के समाधान की आवश्यकता है।
क्या आपको कोई त्रुटि हो रही है?
—
Raystafarian
रेंज बदलना - & gt; .Range ने व्यवहार में बदलाव नहीं किया, जहाँ तक मैं बता सकता हूँ, @ केली।
—
tyblu
मुझे कोई पॉप-अप त्रुटियां नहीं मिलीं, @Raystafarian। उम्मीद है कि कोई डिबग कंसोल नहीं है जिसके बारे में मुझे नहीं पता ...
—
tyblu
मैं प्रजनन नहीं कर सकता। टिप्पणी बाहर
—
Kyle
Application.ScreenUpdating = False अपने कोड के माध्यम से लाइन और चरण देखें कि यह वह नहीं करता है जो आप अपेक्षा करते हैं।
Range("...")सेवा मेरे.Range("...")