VBA
स्क्रिप्टिंग। छाया वस्तु
खोज…
टिप्पणियों
आपको स्क्रिप्टिंग शब्दकोश ऑब्जेक्ट के शुरुआती बाइंडिंग को लागू करने के लिए VBE के टूल → संदर्भ कमांड के माध्यम से VBA प्रोजेक्ट में Microsoft स्क्रिप्टिंग रनटाइम जोड़ना होगा। यह पुस्तकालय संदर्भ परियोजना के साथ किया जाता है; जब VBA प्रोजेक्ट वितरित किया जाता है और किसी अन्य कंप्यूटर पर चलाया जाता है, तो इसे फिर से संदर्भित नहीं करना पड़ता है।
गुण और विधियाँ
एक स्क्रिप्टिंग शब्दकोश वस्तु कुंजी / आइटम जोड़े में जानकारी संग्रहीत करता है। कुंजियाँ अद्वितीय होनी चाहिए और एक सरणी नहीं, लेकिन संबंधित आइटम को दोहराया जा सकता है (उनकी विशिष्टता साथी के पास होती है) और किसी भी प्रकार के प्रकार या वस्तु की हो सकती है।
एक शब्दकोश पहले 'क्षेत्र' (कुंजी) एक प्राथमिक अद्वितीय सूचकांक के साथ एक दो क्षेत्र में स्मृति डेटाबेस के रूप में के बारे में सोचा जा सकता है। कीज़ प्रॉपर्टी पर यह अद्वितीय इंडेक्स एक कुंजी से जुड़े आइटम मूल्य को पुनः प्राप्त करने के लिए बहुत तेज़ 'लुकअप' की अनुमति देता है।
गुण
नाम | पढ़ना लिखना | प्रकार | विवरण |
---|---|---|---|
CompareMode | पढ़ना लिखना | तुलनात्मक स्थिर | कंपेरिमोड सेट करना केवल एक खाली शब्दकोष पर किया जा सकता है। स्वीकृत मान 0 (vbBinaryCompare), 1 (vbTextCompare), 2 (vbDatabaseCompare) हैं। |
गिनती | सिफ़ पढ़िये | अहस्ताक्षरित लंबे पूर्णांक | स्क्रिप्टिंग डिक्शनरी ऑब्जेक्ट में कुंजी / आइटम जोड़े की एक-आधारित गणना। |
चाभी | पढ़ना लिखना | गैर-सरणी संस्करण | शब्दकोश में प्रत्येक व्यक्ति अद्वितीय कुंजी। |
आइटम ( कुंजी ) | पढ़ना लिखना | कोई भी संस्करण | डिफ़ॉल्ट संपत्ति। शब्दकोश में एक कुंजी के साथ जुड़े प्रत्येक व्यक्तिगत आइटम। ध्यान दें कि एक कुंजी के साथ एक आइटम को पुनः प्राप्त करने का प्रयास करना जो शब्दकोष में मौजूद नहीं है, उत्तीर्ण कुंजी को जोड़ देगा। |
तरीके
नाम | विवरण |
---|---|
जोड़ें ( कुंजी , आइटम ) | शब्दकोश में एक नई कुंजी और आइटम जोड़ता है। नई कुंजी को शब्दकोश के वर्तमान कुंजी संग्रह में मौजूद नहीं होना चाहिए, लेकिन एक आइटम को कई अद्वितीय कुंजियों के बीच दोहराया जा सकता है। |
अस्तित्व ( कुंजी ) | बूलियन यह निर्धारित करने के लिए परीक्षण करता है कि क्या कुंजी पहले से ही शब्दकोश में मौजूद है। |
चांबियाँ | अद्वितीय कुंजियों की सरणी या संग्रह लौटाता है। |
आइटम | संबंधित आइटम की सरणी या संग्रह लौटाता है। |
निकालें ( कुंजी ) | एक व्यक्तिगत शब्दकोश कुंजी और उससे संबंधित आइटम निकालता है। |
सभी हटाएं | एक शब्दकोश वस्तु की कुंजी और आइटम के सभी साफ़ करता है। |
नमूना कोड
'Populate, enumerate, locate and remove entries in a dictionary that was created
'with late binding
Sub iterateDictionaryLate()
Dim k As Variant, dict As Object
Set dict = CreateObject("Scripting.Dictionary")
dict.CompareMode = vbTextCompare 'non-case sensitive compare model
'populate the dictionary
dict.Add Key:="Red", Item:="Balloon"
dict.Add Key:="Green", Item:="Balloon"
dict.Add Key:="Blue", Item:="Balloon"
'iterate through the keys
For Each k In dict.Keys
Debug.Print k & " - " & dict.Item(k)
Next k
'locate the Item for Green
Debug.Print dict.Item("Green")
'remove key/item pairs from the dictionary
dict.Remove "blue" 'remove individual key/item pair by key
dict.RemoveAll 'remove all remaining key/item pairs
End Sub
'Populate, enumerate, locate and remove entries in a dictionary that was created
'with early binding (see Remarks)
Sub iterateDictionaryEarly()
Dim d As Long, k As Variant
Dim dict As New Scripting.Dictionary
dict.CompareMode = vbTextCompare 'non-case sensitive compare model
'populate the dictionary
dict.Add Key:="Red", Item:="Balloon"
dict.Add Key:="Green", Item:="Balloon"
dict.Add Key:="Blue", Item:="Balloon"
dict.Add Key:="White", Item:="Balloon"
'iterate through the keys
For Each k In dict.Keys
Debug.Print k & " - " & dict.Item(k)
Next k
'iterate through the keys by the count
For d = 0 To dict.Count - 1
Debug.Print dict.Keys(d) & " - " & dict.Items(d)
Next d
'iterate through the keys by the boundaries of the keys collection
For d = LBound(dict.Keys) To UBound(dict.Keys)
Debug.Print dict.Keys(d) & " - " & dict.Items(d)
Next d
'locate the Item for Green
Debug.Print dict.Item("Green")
'locate the Item for the first key
Debug.Print dict.Item(dict.Keys(0))
'locate the Item for the last key
Debug.Print dict.Item(dict.Keys(UBound(dict.Keys)))
'remove key/item pairs from the dictionary
dict.Remove "blue" 'remove individual key/item pair by key
dict.Remove dict.Keys(0) 'remove first key/item by index position
dict.Remove dict.Keys(UBound(dict.Keys)) 'remove last key/item by index position
dict.RemoveAll 'remove all remaining key/item pairs
End Sub
स्क्रिप्टिंग के साथ डेटा एकत्र करना। छाया (अधिकतम, गणना)
डिक्शनरी उन सूचनाओं को प्रबंधित करने के लिए बहुत अच्छी है जहाँ कई प्रविष्टियाँ होती हैं, लेकिन आप केवल प्रविष्टियों के प्रत्येक सेट के लिए एक ही मूल्य से संबंधित हैं - पहला या अंतिम मान, मिनिनम या अधिकतम मूल्य, एक औसत, एक राशि आदि।
एक कार्यपुस्तिका पर विचार करें, जो उपयोगकर्ता गतिविधि का एक लॉग रखती है, एक स्क्रिप्ट के साथ जो उपयोगकर्ता नाम सम्मिलित करती है और हर बार किसी व्यक्ति द्वारा कार्य संपादित करने की तिथि संपादित करती है:
वर्कशीट
Log
ए बी बॉब 10/12/2016 9:00 ऐलिस 10/13/2016 13:00 बॉब 10/13/2016 13:30 ऐलिस 10/13/2016 14:00 ऐलिस 10/14/2016 13:00
मान लीजिए कि आप Summary
नामक एक वर्कशीट में प्रत्येक उपयोगकर्ता के लिए अंतिम संपादन समय का उत्पादन करना चाहते हैं।
टिप्पणियाँ:
1. डेटा को ActiveWorkbook
में माना जाता है।
2. हम वर्कशीट से मान खींचने के लिए एक सरणी का उपयोग कर रहे हैं; यह प्रत्येक कोशिका पर पुनरावृत्ति करने से अधिक कुशल है।
3. Dictionary
प्रारंभिक बंधन का उपयोग करके बनाया गया है।
Sub LastEdit()
Dim vLog as Variant, vKey as Variant
Dim dict as New Scripting.Dictionary
Dim lastRow As Integer, lastColumn As Integer
Dim i as Long
Dim anchor As Range
With ActiveWorkbook
With .Sheets("Log")
'Pull entries in "log" into a variant array
lastRow = .Range("a" & .Rows.Count).End(xlUp).Row
vlog = .Range("a1", .Cells(lastRow, 2)).Value2
'Loop through array
For i = 1 to lastRow
Dim username As String
username = vlog(i, 1)
Dim editDate As Date
editDate = vlog(i, 2)
'If the username is not yet in the dictionary:
If Not dict.Exists(username) Then
dict(username) = editDate
ElseIf dict(username) < editDate Then
dict(username) = editDate
End If
Next
End With
With .Sheets("Summary")
'Loop through keys
For Each vKey in dict.Keys
'Add the key and value at the next available row
Anchor = .Range("A" & .Rows.Count).End(xlUp).Offset(1,0)
Anchor = vKey
Anchor.Offset(0,1) = dict(vKey)
Next vKey
End With
End With
End Sub
और आउटपुट इस तरह दिखेगा:
Summary
वर्कशीट
ए बी बॉब 10/13/2016 13:30 ऐलिस 10/14/2016 13:00
यदि दूसरी तरफ आप यह आउटपुट करना चाहते हैं कि प्रत्येक उपयोगकर्ता ने कितनी बार वर्कबुक को एडिट किया है, तो For
लूप की बॉडी इस तरह दिखनी चाहिए:
'Loop through array
For i = 1 to lastRow
Dim username As String
username = vlog(i, 1)
'If the username is not yet in the dictionary:
If Not dict.Exists(username) Then
dict(username) = 1
Else
dict(username) = dict(username) + 1
End If
Next
और आउटपुट इस तरह दिखेगा:
Summary
कार्यपत्रक
ए बी बॉब 2 ऐलिस 3
Scripting.Dictionary के साथ अद्वितीय मान प्राप्त करना
Dictionary
बहुत सरलता से मूल्यों का एक अनूठा सेट प्राप्त करने की अनुमति देता है। निम्नलिखित कार्य पर विचार करें:
Function Unique(values As Variant) As Variant()
'Put all the values as keys into a dictionary
Dim dict As New Scripting.Dictionary
Dim val As Variant
For Each val In values
dict(val) = 1 'The value doesn't matter here
Next
Unique = dict.Keys
End Function
जिसे आप फिर इस तरह से कॉल कर सकते हैं:
Dim duplicates() As Variant
duplicates = Array(1, 2, 3, 1, 2, 3)
Dim uniqueVals() As Variant
uniqueVals = Unique(duplicates)
और uniqueVals
में केवल {1,2,3}
शामिल होंगे।
नोट: इस फ़ंक्शन का उपयोग किसी भी गणना योग्य वस्तु के साथ किया जा सकता है।