excel-vba
ऑटोफिल्टर; उपयोग और सर्वोत्तम अभ्यास
खोज…
परिचय
ऑटोफिल्टर अंतिम लक्ष्य उन वस्तुओं पर ध्यान देने के लिए सैकड़ों या हजारों पंक्तियों के डेटा से त्वरित तरीके से संभव डेटा खनन प्रदान करना है, जिस पर हम ध्यान केंद्रित करना चाहते हैं। यह "पाठ / मान / रंग" जैसे मापदंडों को प्राप्त कर सकता है और उन्हें स्तंभों के बीच स्टैक्ड किया जा सकता है। आप लॉजिक कनेक्टर और नियमों के सेट के आधार पर प्रति कॉलम 2 मानदंड तक कनेक्ट कर सकते हैं। रिमार्क: ऑटोफिल्टर पंक्तियों को फ़िल्टर करके काम करता है, स्तंभों को फ़िल्टर करने के लिए कोई ऑटोफ़िल्टर नहीं है (कम से कम मूल रूप से नहीं)।
टिप्पणियों
'VBA के भीतर ऑटोफिल्टर का उपयोग करने के लिए हमें कम से कम निम्नलिखित मानकों के साथ कॉल करना होगा:
शीट ("MySheet")। रेंज ("MyRange")। ऑटोफ़िल्टर फ़ील्ड = (कॉलमनिम्बरविथिन "MyRange" ToBeFilteredInNumericValue) मानदंड 1: = "WhatIWantToFilter"
'वहाँ उदाहरण के बहुत सारे वेब पर या यहाँ या तो कर रहे हैं stackoverflow पर
Smartfilter!
समस्या की स्थिति
वेयरहाउस व्यवस्थापक के पास एक पत्रक ("रिकॉर्ड") होता है, जहां सुविधा द्वारा निष्पादित हर लॉजिस्टिक मूवमेंट संग्रहीत होता है, वह आवश्यकतानुसार फिल्टर कर सकता है, हालांकि, यह बहुत समय लेने वाला है और वह पूछताछ को तेजी से गणना करने के लिए प्रक्रिया में सुधार करना चाहता है, के लिए उदाहरण: अब हमारे पास (सभी रैक में) कितने "पल्प" हैं? अब हमारे पास कितने पल्प हैं (रैक # 5 में)? फिल्टर एक महान उपकरण हैं लेकिन, वे सेकंड के मामले में इस तरह के सवाल का जवाब देने के लिए कुछ हद तक सीमित हैं।
मैक्रो समाधान:
कोडर जानता है कि इस तरह के परिदृश्यों में ऑटोफ़िल्टर सबसे अच्छा, तेज़ और सबसे विश्वसनीय समाधान हैं क्योंकि डेटा पहले से ही वर्कशीट में मौजूद है और उनके लिए इनपुट आसानी से प्राप्त किया जा सकता है , उपयोगकर्ता इनपुट द्वारा- इस मामले में।
उपयोग किया जाने वाला दृष्टिकोण "स्मार्टफिल्टर" नामक एक शीट बनाने के लिए है, जहां व्यवस्थापक आसानी से आवश्यकतानुसार कई डेटा को फ़िल्टर कर सकता है और गणना तुरंत भी की जाएगी।
वह इस मामले के लिए 2 मॉड्यूल और Worksheet_Change
घटना का उपयोग करता है
स्मार्टफिल्टर वर्कशीट के लिए कोड:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ItemInRange As Range
Const CellsFilters As String = "C2,E2,G2"
Call ExcelBusy
For Each ItemInRange In Target
If Not Intersect(ItemInRange, Range(CellsFilters)) Is Nothing Then Call Inventory_Filter
Next ItemInRange
Call ExcelNormal
End Sub
मॉड्यूल 1 के लिए कोड, जिसे "General_Functions" कहा जाता है
Sub ExcelNormal()
With Excel.Application
.EnableEvents = True
.Cursor = xlDefault
.ScreenUpdating = True
.DisplayAlerts = True
.StatusBar = False
.CopyObjectsWithCells = True
End With
End Sub
Sub ExcelBusy()
With Excel.Application
.EnableEvents = False
.Cursor = xlWait
.ScreenUpdating = False
.DisplayAlerts = False
.StatusBar = False
.CopyObjectsWithCells = True
End With
End Sub
Sub Select_Sheet(NameSheet As String, Optional VerifyExistanceOnly As Boolean)
On Error GoTo Err01Select_Sheet
Sheets(NameSheet).Visible = True
If VerifyExistanceOnly = False Then ' 1. If VerifyExistanceOnly = False
Sheets(NameSheet).Select
Sheets(NameSheet).AutoFilterMode = False
Sheets(NameSheet).Cells.EntireRow.Hidden = False
Sheets(NameSheet).Cells.EntireColumn.Hidden = False
End If ' 1. If VerifyExistanceOnly = False
If 1 = 2 Then '99. If error
Err01Select_Sheet:
MsgBox "Err01Select_Sheet: Sheet " & NameSheet & " doesn't exist!", vbCritical: Call ExcelNormal: On Error GoTo -1: End
End If '99. If error
End Sub
Function General_Functions_Find_Title(InSheet As String, TitleToFind As String, Optional InRange As Range, Optional IsNeededToExist As Boolean, Optional IsWhole As Boolean) As Range
Dim DummyRange As Range
On Error GoTo Err01General_Functions_Find_Title
If InRange Is Nothing Then ' 1. If InRange Is Nothing
Set DummyRange = IIf(IsWhole = True, Sheets(InSheet).Cells.Find(TitleToFind, LookAt:=xlWhole), Sheets(InSheet).Cells.Find(TitleToFind, LookAt:=xlPart))
Else ' 1. If InRange Is Nothing
Set DummyRange = IIf(IsWhole = True, Sheets(InSheet).Range(InRange.Address).Find(TitleToFind, LookAt:=xlWhole), Sheets(InSheet).Range(InRange.Address).Find(TitleToFind, LookAt:=xlPart))
End If ' 1. If InRange Is Nothing
Set General_Functions_Find_Title = DummyRange
If 1 = 2 Or DummyRange Is Nothing Then '99. If error
Err01General_Functions_Find_Title:
If IsNeededToExist = True Then MsgBox "Err01General_Functions_Find_Title: Ttile '" & TitleToFind & "' was not found in sheet '" & InSheet & "'", vbCritical: Call ExcelNormal: On Error GoTo -1: End
End If '99. If error
End Function
मॉड्यूल 2 के लिए कोड, जिसे "इन्वेंटरी_हैंडलिंग" कहा जाता है
Const TitleDesc As String = "DESCRIPTION"
Const TitleLocation As String = "LOCATION"
Const TitleActn As String = "ACTION"
Const TitleQty As String = "QUANTITY"
Const SheetRecords As String = "Record"
Const SheetSmartFilter As String = "SmartFilter"
Const RowFilter As Long = 2
Const ColDataToPaste As Long = 2
Const RowDataToPaste As Long = 7
Const RangeInResult As String = "K1"
Const RangeOutResult As String = "K2"
Sub Inventory_Filter()
Dim ColDesc As Long: ColDesc = General_Functions_Find_Title(SheetSmartFilter, TitleDesc, IsNeededToExist:=True, IsWhole:=True).Column
Dim ColLocation As Long: ColLocation = General_Functions_Find_Title(SheetSmartFilter, TitleLocation, IsNeededToExist:=True, IsWhole:=True).Column
Dim ColActn As Long: ColActn = General_Functions_Find_Title(SheetSmartFilter, TitleActn, IsNeededToExist:=True, IsWhole:=True).Column
Dim ColQty As Long: ColQty = General_Functions_Find_Title(SheetSmartFilter, TitleQty, IsNeededToExist:=True, IsWhole:=True).Column
Dim CounterQty As Long
Dim TotalQty As Long
Dim TotalIn As Long
Dim TotalOut As Long
Dim RangeFiltered As Range
Call Select_Sheet(SheetSmartFilter)
If Cells(Rows.Count, ColDataToPaste).End(xlUp).Row > RowDataToPaste - 1 Then Rows(RowDataToPaste & ":" & Cells(Rows.Count, "B").End(xlUp).Row).Delete
Sheets(SheetRecords).AutoFilterMode = False
If Cells(RowFilter, ColDesc).Value <> "" Or Cells(RowFilter, ColLocation).Value <> "" Or Cells(RowFilter, ColActn).Value <> "" Then ' 1. If Cells(RowFilter, ColDesc).Value <> "" Or Cells(RowFilter, ColLocation).Value <> "" Or Cells(RowFilter, ColActn).Value <> ""
With Sheets(SheetRecords).UsedRange
If Sheets(SheetSmartFilter).Cells(RowFilter, ColDesc).Value <> "" Then .AutoFilter Field:=General_Functions_Find_Title(SheetRecords, TitleDesc, IsNeededToExist:=True, IsWhole:=True).Column, Criteria1:=Sheets(SheetSmartFilter).Cells(RowFilter, ColDesc).Value
If Sheets(SheetSmartFilter).Cells(RowFilter, ColLocation).Value <> "" Then .AutoFilter Field:=General_Functions_Find_Title(SheetRecords, TitleLocation, IsNeededToExist:=True, IsWhole:=True).Column, Criteria1:=Sheets(SheetSmartFilter).Cells(RowFilter, ColLocation).Value
If Sheets(SheetSmartFilter).Cells(RowFilter, ColActn).Value <> "" Then .AutoFilter Field:=General_Functions_Find_Title(SheetRecords, TitleActn, IsNeededToExist:=True, IsWhole:=True).Column, Criteria1:=Sheets(SheetSmartFilter).Cells(RowFilter, ColActn).Value
'If we don't use a filter we would need to use a cycle For/to or For/Each Cell in range
'to determine whether or not the row meets the criteria that we are looking and then
'save it on an array, collection, dictionary, etc
'IG: For CounterRow = 2 To TotalRows
'If Sheets(SheetSmartFilter).Cells(RowFilter, ColDesc).Value <> "" and Sheets(SheetRecords).cells(CounterRow,ColDescInRecords).Value= Sheets(SheetSmartFilter).Cells(RowFilter, ColDesc).Value then
'Redim Preserve MyUnecessaryArray(UnecessaryNumber) ''Save to array: (UnecessaryNumber)=MyUnecessaryArray. Or in a dictionary, etc. At the end, we would transpose this values into the sheet, at the end
'both are the same, but, just try to see the time invested on each logic.
If .Cells(1, 1).End(xlDown).Value <> "" Then Set RangeFiltered = .Rows("2:" & Sheets(SheetRecords).Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
'If it is not <>"" means that there was not filtered data!
If RangeFiltered Is Nothing Then MsgBox "Err01Inventory_Filter: No data was found with the given criteria!", vbCritical: Call ExcelNormal: End
RangeFiltered.Copy Destination:=Cells(RowDataToPaste, ColDataToPaste)
TotalQty = Cells(Rows.Count, ColQty).End(xlUp).Row
For CounterQty = RowDataToPaste + 1 To TotalQty
If Cells(CounterQty, ColActn).Value = "In" Then ' 2. If Cells(CounterQty, ColActn).Value = "In"
TotalIn = Cells(CounterQty, ColQty).Value + TotalIn
ElseIf Cells(CounterQty, ColActn).Value = "Out" Then ' 2. If Cells(CounterQty, ColActn).Value = "In"
TotalOut = Cells(CounterQty, ColQty).Value + TotalOut
End If ' 2. If Cells(CounterQty, ColActn).Value = "In"
Next CounterQty
Range(RangeInResult).Value = TotalIn
Range(RangeOutResult).Value = -(TotalOut)
End With
End If ' 1. If Cells(RowFilter, ColDesc).Value <> "" Or Cells(RowFilter, ColLocation).Value <> "" Or Cells(RowFilter, ColActn).Value <> ""
End Sub
परीक्षण और परिणाम:
जैसा कि हमने पिछली छवि में देखा था, यह कार्य आसानी से प्राप्त किया गया है। ऑटोफिल्टर्स का उपयोग करके एक समाधान प्रदान किया गया था जिसे गणना करने में केवल कुछ सेकंड लगते हैं, उपयोगकर्ता -एस को समझाने में आसान है / वह इस कमांड से परिचित है- और कुछ पंक्तियों को कोडर में ले गया।