2015-11-19 11 views
1

Я создаю уникальные коллекции из каждого столбца в моем листе под заголовками столбцов, используя словарь. Заголовки столбцов приведены в строке 1.VBA Словарь словарей?

Проблема заключается в том, что мои словари содержат уникальные элементы из предыдущих столбцов. например, если вызывать словарь из столбца 4, он содержит все уникальные элементы и заголовки из столбцов 1,2,3. Мне нужны только уникальные предметы из этой столбчатой ​​колонны. Любая идея, как исправить этот код ?.

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 

Благодаря

+0

Вы должны добавить некоторые комментарии, как для нас, так и самостоятельно; трудно точно сказать, что вы пытаетесь сделать здесь. –

+0

Почти такой же код, что и некоторые предыдущие вопросы, нет четких объяснений, и вы все еще работаете с пустым словарем ... – R3uK

+0

Как мой словарь пуст ?. d - глобальный объект. – Shan

ответ

1

Рассмотрим следующий пример, основанный на коде с незначительными изменениями, которые я сделал:

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 
+0

спасибо .. хорошо работает. – Shan

0

Если у меня есть это правильно, у вас есть дубликаты в разных столбцах. Таким образом, ваши ключи в словаре не уникальны, поскольку вы перебираете столбцы. Если это так, когда вы добавляете ключи в словарь, создайте составной ключ. Например, что-то вроде:

Dim Skey как строка Skey = «A ~» & «ABCD»

Это будет сделать ключ, уникальный для столбца A. При обработке коллекции, вы можете вырезать «A ~» для каждого столбца.

Смежные вопросы