VBA字典词典?

扫码查看
本文介绍了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字典词典?的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持!

05-28 00:00
查看更多