शिकागो के करेन में 200 कॉलम के साथ एक वर्कशीट है। फ़िल्टर ड्रॉप-डाउन सक्षम हैं। वह यह देखना चाहती है कि किन कॉलमों में फ़िल्टर लगाया गया है और उन कॉलमों पर कौन सा फ़िल्टर लगाया गया है।
करेन हेडर पंक्ति में फ़नल आइकन को देखने के लिए पहले से ही जानता था, लेकिन सैकड़ों स्तंभों के साथ, यह समय लेने वाला हो सकता है।
मेरा पहला पड़ाव UserVoice था। वहां एक विचार पोस्ट किया गया था, लेकिन इसमें केवल एक वोट है।
मैंने अपने एमवीपी दोस्तों से पूछा कि क्या उन्हें ऐसा करने का कोई विचार है।
रोजर गोविअर के पास कुछ कोड थे जो उन्होंने मूल रूप से कॉन्टेक्स्ट पर एक लेख के लिए लिखे थे। उन्होंने उस कोड को अनुकूलित किया और फिर मैंने https://yoursumbuddy.com/autofilter-vba-operator-parameters/ पर प्रदान की गई महान सूची का उपयोग करके उनके कोड को अनुकूलित किया।
मौजूदा शीट के ऑटिफ़िल्टर में सभी कॉलम के माध्यम से रोजर का कोड लूप करता है। यदि कोई फ़िल्टर सेट किया गया है, तो यह देखने के लिए ActiveSheet.AutoFilter.Filters.Item(1).Criteria1, .Criteria2और .Operatorयह पता लगाने के लिए कि क्या फ़िल्टर लागू किया गया है और स्तंभ के लिए क्या चुना गया था।
यदि आप एक ऑटोफिल्टर ड्रॉपडाउन को खोलते हैं और एंडी, बेट्टी, चार्ली चुनते हैं, तो .Criteria1यह एक आइटम है। रोजर सरणी के ऊपरी बाउंड के लिए पूछकर एक सरणी के लिए जाँच करता है UBound(.Criteria1)। यदि कोई सरणी है, तो वह सरणी में आइटम के माध्यम से लूप करता है। यदि कोई सरणी नहीं है, तो वह बस उपयोग कर सकता है .Criteria1।
एक .Criteria2संपत्ति है, लेकिन इसका उपयोग केवल तभी होता है जब फ़िल्टर प्रकार OR हो।
.Operatorसंपत्ति सांख्यिक कोड की एक श्रृंखला है:
- एकल आइटम के लिए 0
- 1 के लिए
- OR के लिए 2
- शीर्ष 10 के लिए 3
- बॉटम 10 के लिए 4
- शीर्ष 10 प्रतिशत के लिए 5
- निचले 10 प्रतिशत के लिए 6
- मानों द्वारा फ़िल्टर के लिए 7
- सेल रंग के लिए 8
- फॉन्ट कलर के लिए 9
- आइकन के लिए 10
- डायनेमिक के लिए 11
यदि .Operator11 है, तो इसमें 34 संभावित कोड संग्रहीत हैं .Criteria1। नीचे VBA कोड देखें, लेकिन यह आज के लिए 1 है, कल के लिए 2, कल के लिए 3, और इसी तरह।
पहला कोड करेन को सभी फिल्टर की सूची देता है और उन्हें कैसे लागू किया जाता है:
रोजर गोवियर ने महसूस किया कि इसका उपयोग करना कठिन होगा। उन्होंने आपके डेटा के ऊपर तीन रिक्त पंक्तियों को सम्मिलित करने का सुझाव दिया। ShowFilterValuesकोड चलाएं और आप जल्दी से अगले फ़िल्टर किए गए कॉलम में पंक्ति 1 में Ctrl + Shift + RightArrow का उपयोग करके कूद सकते हैं।
वीडियो देखेंा
एक्सेल फ़ाइल डाउनलोड करें
आप एक्सेल फ़ाइल डाउनलोड कर सकते हैं: जो एक्सेल-कॉलम-हैं-फ़िल्टर्ड। Xlsm
या आप नीचे से मैक्रो को कॉपी और पेस्ट कर सकते हैं।
Sub MessageFilterValues() ' Thanks to Excel MVP Roger Govier for original code ' Modified by Bill Jelen on 12 May 2019 ' based on https://yoursumbuddy.com/autofilter-vba-operator-parameters/ ' This assumes your headings are in row 1. Dim sht As Worksheet Dim f As Long Dim i As Long Dim ItemCount As Long Dim ItemStr As Variant Dim ValA As Variant Dim ValB As Variant Dim ValC As Variant Dim ValD As Variant Set sht = ActiveSheet Msg = "" sht.(A1).Select With sht.AutoFilter currentFiltRange = .Range.Address With .Filters For f = 1 To .Count With .Item(f) If .On Then ValA = "" ValB = "" ValC = "" ValD = "" ' Is .Criteria1 an array? Err.Clear On Error Resume Next ItemCount = UBound(.Criteria1) If Err.Number = 0 Then ItemStr = "" For i = 1 To ItemCount ItemStr = ItemStr & .Criteria1(i) Next i ValA = ItemStr Else ' Not an array ValA = .Criteria1 End If On Error Resume Next ' .Criteria2 is only used for XLOr ValB = .Criteria2 On Error GoTo 0 ' Operator is a series of codes Select Case .Operator Case 0 ValC = "Single Item" Case 1 ValC = "xlAnd" Case 2 ValC = "xlOr" Case 3 ValC = "xlTop10Items" Case 4 ValC = "xlBottom10Items" Case 5 ValC = "xlTop10Percent" Case 6 ValC = "xlBottom10Percent" Case 7 ValC = "xlFilterValues" Case 8 ValC = "xlFilterCellColor" Case 9 ValC = "xlFilterFontColor" Case 10 ValC = "xlFilterIcon" ValA = "Icon #" & .Criteria1.Index Case 11 ValC = "xlFilterDynamic" ' For Dynamic, there are one of 34 values stored in Criteria1 ' Update Criteria1 stored in row 1 Select Case ValA Case 1 ValD = "Today" Case 2 ValD = "Yesterday" Case 3 ValD = "Tomorrow" Case 4 ValD = "This Week" Case 5 ValD = "Last Week" Case 6 ValD = "Next Week" Case 7 ValD = "This Month" Case 8 ValD = "Last Month" Case 9 ValD = "Next Month" Case 10 ValD = "This Quarter" Case 11 ValD = "Last Quarter" Case 12 ValD = "Next Quarter" Case 13 ValD = "This Year" Case 14 ValD = "Last Year" Case 15 ValD = "Next Year" Case 16 ValD = "Year to Date" Case 17 ValD = "Q1" Case 18 ValD = "Q2" Case 19 ValD = "Q3" Case 20 ValD = "Q4" Case 21 ValD = "January" Case 22 ValD = "February" Case 23 ValD = "March" Case 24 ValD = "April" Case 25 ValD = "May" Case 26 ValD = "June" Case 27 ValD = "July" Case 28 ValD = "August" Case 29 ValD = "September" Case 30 ValD = "October" Case 31 ValD = "November" Case 32 ValD = "December" Case 33 ValD = "Above Average" Case 34 ValD = "Below Average" End Select ValA = ValD End Select Msg = Msg & Cells(1, f).Address(0, 0) & ": " & ValA & " " & ValB & " (" & ValC & ")" & vbLf End If End With Next f End With End With If Msg = "" Then Msg = "No columns filtered" MsgBox Prompt:=Msg, Title:="Filtered Columns" End Sub Sub ShowFilterValues() ' Thanks to Excel MVP Roger Govier for original code ' Modified by Bill Jelen on 12 May 2019 ' based on https://yoursumbuddy.com/autofilter-vba-operator-parameters/ ' Requires you to have three blank rows above your data Dim sht As Worksheet Dim filterArray() Dim f As Long Dim i As Long Dim ItemCount As Long Dim ItemStr As Variant Set sht = ActiveSheet sht.Rows("1:3").ClearContents With sht.Rows("1:3") .ClearContents .NumberFormat = "@" With .Font .Bold = True .Color = XlRgbColor.rgbRed End With End With sht.(A4).Select With sht.AutoFilter currentFiltRange = .Range.Address With .Filters ReDim filterArray(1 To .Count) For f = 1 To .Count With .Item(f) If .On Then ' Is .Criteria1 an array? Err.Clear On Error Resume Next ItemCount = UBound(.Criteria1) If Err.Number = 0 Then ItemStr = "" For i = 1 To ItemCount ItemStr = ItemStr & .Criteria1(i) Next i sht.Cells(1, f) = ItemStr Else ' Not an array sht.Cells(1, f) = .Criteria1 End If On Error Resume Next ' .Criteria2 is only used for XLOr sht.Cells(2, f) = .Criteria2 On Error GoTo 0 ' Operator is a series of codes Select Case .Operator Case 0 sht.Cells(3, f) = "Single Item" Case 1 sht.Cells(3, f) = "xlAnd" Case 2 sht.Cells(3, f) = "xlOr" Case 3 sht.Cells(3, f) = "xlTop10Items" Case 4 sht.Cells(3, f) = "xlBottom10Items" Case 5 sht.Cells(3, f) = "xlTop10Percent" Case 6 sht.Cells(3, f) = "xlBottom1010Percent" Case 7 sht.Cells(3, f) = "xlFilterValues" Case 8 sht.Cells(3, f) = "xlFilterCellColor" Case 9 sht.Cells(3, f) = "xlFilterFontColor" Case 10 sht.Cells(3, f) = "xlFilterIcon" sht.Cells(1, f) = "Icon #" & .Criteria1.Index Case 11 sht.Cells(3, f) = "xlFilterDynamic" ' For Dynamic, there are one of 34 values stored in Criteria1 ' Update Criteria1 stored in row 1 Select Case sht.Cells(1, f).Value Case 1 sht.Cells(1, f).Value = "Today" Case 2 sht.Cells(1, f).Value = "Yesterday" Case 3 sht.Cells(1, f).Value = "Tomorrow" Case 4 sht.Cells(1, f).Value = "This Week" Case 5 sht.Cells(1, f).Value = "Last Week" Case 6 sht.Cells(1, f).Value = "Next Week" Case 7 sht.Cells(1, f).Value = "This Month" Case 8 sht.Cells(1, f).Value = "Last Month" Case 9 sht.Cells(1, f).Value = "Next Month" Case 10 sht.Cells(1, f).Value = "This Quarter" Case 11 sht.Cells(1, f).Value = "Last Quarter" Case 12 sht.Cells(1, f).Value = "Next Quarter" Case 13 sht.Cells(1, f).Value = "This Year" Case 14 sht.Cells(1, f).Value = "Last Year" Case 15 sht.Cells(1, f).Value = "Next Year" Case 16 sht.Cells(1, f).Value = "Year to Date" Case 17 sht.Cells(1, f).Value = "Q1" Case 18 sht.Cells(1, f).Value = "Q2" Case 19 sht.Cells(1, f).Value = "Q3" Case 20 sht.Cells(1, f).Value = "Q4" Case 21 sht.Cells(1, f).Value = "January" Case 22 sht.Cells(1, f).Value = "February" Case 23 sht.Cells(1, f).Value = "March" Case 24 sht.Cells(1, f).Value = "April" Case 25 sht.Cells(1, f).Value = "May" Case 26 sht.Cells(1, f).Value = "June" Case 27 sht.Cells(1, f).Value = "July" Case 28 sht.Cells(1, f).Value = "August" Case 29 sht.Cells(1, f).Value = "September" Case 30 sht.Cells(1, f).Value = "October" Case 31 sht.Cells(1, f).Value = "November" Case 32 sht.Cells(1, f).Value = "December" Case 33 sht.Cells(1, f).Value = "Above Average" Case 34 sht.Cells(1, f).Value = "Below Average" End Select End Select End If End With Next f End With End With End Subएक्सेल एमवीपी जॉन अकम्पोरा इसी तरह की कार्यक्षमता के साथ $ 27 फिल्टर-मेट ऐड-इन प्रदान करता है। Https://www.excelcampus.com/filter-mate/ पर अधिक जानें।
