本文介绍了VBA字典词典?的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我正在使用字典对象从工作表中列标题下的每一列中创建唯一集合.列标题位于第1行中.
I am creating unique collections from every column in my sheet under the column headings using dictionary object. Column headings are in Row 1.
问题是我的词典包含以前各列中的唯一项.例如,如果调用第4列的字典,则它包含第1,2,3列的所有唯一项和标题.我只需要该纵列中的唯一项.知道如何更正此代码吗?.
Problem is my dictionaries contains unique items from previous columns. for example if call a dictionary of column 4, it contains all unique items and headings from columns 1,2,3. I need only unique items from that perticular column. Any idea how to correct this code?.
Sub cre_Dict()
Dim fulArr As Variant
Set d = CreateObject("scripting.dictionary")
With Sheets("Database")
fulArr = .Range("A1:IO27") 'assign whole table to array
For j = 1 To UBound(fulArr, 2) 'looping from 1st column to last column
For i = 2 To UBound(fulArr, 1) 'looping from row2 to last row
If Len(fulArr(i, j)) > 0 Then 'if not blank cell
d00 = d.Item(fulArr(i, j)) 'add to dictionary
End If
Next i
d(fulArr(1, j)) = d.keys 'create dictionary under column heading
Next j
End With
End Sub
谢谢
推荐答案
根据您对我进行了微小更改的代码,考虑以下示例:
Consider the below example, based on your code with minor changes I have made:
Dim d As Object
Sub cre_Dict()
Dim fulArr As Variant
Dim q As Object
Dim j As Long
Dim i As Long
Set d = CreateObject("Scripting.Dictionary")
fulArr = Sheets("Database").Range("A1:IO27") 'assign whole table to array
For j = 1 To UBound(fulArr, 2) 'looping from 1st column to last column
Set q = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(fulArr, 1) 'looping from row2 to last row
If Len(fulArr(i, j)) > 0 Then 'if not blank cell
q(fulArr(i, j)) = Empty 'add to dictionary
End If
Next i
d(fulArr(1, j)) = q.Keys 'create dictionary under column heading
Next j
End Sub
这篇关于VBA字典词典?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!