VBA：嵌套字典是一个很好的解决方案吗？-VBA:Isnesteddictionaryagoodsolutionforthis?

0  

I think the nested dictionaries could work; although you would have to make a few changes to make the colors dictionary truly column specific.

我认为嵌套的词典可以工作;虽然您必须进行一些更改才能使颜色字典真正特定于列。

Note my changes in your code below:

请注意我在以下代码中的更改:

• Did not explicitly declare a single Colors dictionary. Declaring specific colors dictionary meant:

  没有明确声明单个Colors字典。声明特定颜色字典意味着:

  • Sub/Function level variable (apparent Global dictionary behavior)

  子/函数级变量(明显的全局字典行为)

  • Adding to Columns dictionary, simply added additional references to existing Colors Dictionary

  添加到列字典,只需添加对现有颜色字典的其他引用

  • Can reference Colors dictionary by variable name

  可以通过变量名称引用Colors词典

• Instead, when the cell is in a new column, add a new dictionary into the Columns dictionary. This means:

  相反,当单元格位于新列中时,将新字典添加到“列”字典中。意即:

  • Each dictionary "added" to the columns dictionary is unique.

  每个字典“添加”到列字典中是唯一的。

  • Column-level variable; instead of global

  列级变量;而不是全球

  • Can not refer to dictionary by name; only by reference to item/key connection from the Columns dictionary

  不能按名称参考字典;仅通过引用Columns字典中的item / key连接

  • Code to add color to color dictionary(s) becomes identical between if column exists or if it does not (thus, the slight change in the logic block)

  在列存在或不存在的情况下,为颜色字典添加颜色的代码变得相同(因此,逻辑块中的轻微更改)

• Dim c As Variant: This is what your code was doing implicitly. For VBA variables, each variable needs to be declared separately, or it defaults to Variant

  Dim c As Variant:这是您的代码隐式执行的操作。对于VBA变量,每个变量需要单独声明,或者默认为Variant

  • If c is declared as long, a different Variant variable will need to be declared for looping through the dictionary keys.

  如果c声明为long,则需要声明一个不同的Variant变量来循环遍历字典键。

Note: The line Columns(c).Add cellColor, r adds the cell color as a key in the dictionary and the row as the item. This means that if that color already exists in that dictionary, the item will be overwritten with the new row value. Looking at your code, that shouldn't be an issue (selecting r as row value from looping through row numbers), but I thought I should mention this just in case you were planning on preserving the row values of the originally selected cells.

注意:行Columns(c).Add cellColor,r将单元格颜色添加为字典中的键,将行添加为项目。这意味着如果该字典中已存在该颜色,则该项将被新行值覆盖。看看你的代码,这不应该是一个问题(从循环遍历行号选择r作为行值),但我想我应该提到这一点,以防你计划保留最初选择的单元格的行值。

Dim objSelection As Range
Dim objSelectionArea As Range
Dim objCell As Range
Dim c As Variant 'Made implied declaration explicit. Needs to be variant or the "for each c" loop fails
Dim r As Long
Dim Columns As New Scripting.Dictionary

' Get the current selection
Set objSelection = Application.Selection

' Walk through the areas
For Each objSelectionArea In objSelection.Areas

    ' Walk through the cells in an area
    For Each objCell In objSelectionArea
        c = objCell.Column
        r = objCell.Row
        cellColor = objCell.Interior.Color

        ' If this is a new column add it to dictionary. Also add color.
        ' Simplified If-End If....
        If Not Columns.Exists(c) Then
            ' Put color dictionary into column dictionary
            Columns.Add c, New Scripting.Dictionary ' Creates new dictionary for each column
        End If

        ' Put cell color into color dictionary as key
        Columns(c).Add cellColor, r
    Next

Next

0  

I think it's an efficient data structure

我认为这是一种有效的数据结构

This uses nested dictionaries of colors, based on columns

这使用基于列的嵌套颜色词典

Option Explicit

Public Sub GetColColorsBasedOnSelectedRows()
    Dim ur As Range, c As Long, r As Long, rCnt As Long, cCnt As Long, sel As Range
    Dim d As Dictionary, dColors As Dictionary, cc As Long, res As String, sCell As Range

    Set ur = Sheet1.UsedRange
    rCnt = ur.Rows.Count
    cCnt = ur.Columns.Count
    Set d = New Scripting.Dictionary
    For c = 1 To cCnt   'Get all colors in all used range, by columns
        Set dColors = New Scripting.Dictionary
        For r = 1 To rCnt
            cc = ur(r, c).Interior.Color
            If InStr(1, dColors(cc), r & ", ") = 0 Then
                dColors(cc) = dColors(cc) & r & ", "
            End If
        Next
        Set d(c) = dColors
    Next
    Dim msg As String, shown As Dictionary
    Set shown = New Scripting.Dictionary
    For Each sel In Application.Selection.Areas
        For Each sCell In sel.Cells
            If Not shown.Exists(sCell.Column & "-" & sCell.Interior.Color) Then
                msg = msg & sCell.Address(0, 0) & ", "
                res = res & d(sCell.Column)(sCell.Interior.Color)
                shown(sCell.Column & "-" & sCell.Interior.Color) = 0
            End If
        Next
    Next
    Debug.Print "Selected cells: " & Left(msg, Len(msg) - 2)
    Debug.Print "Row colors:     " & Left(res, Len(res) - 2) & vbCrLf
    ShowAllItems d
End Sub

Private Sub ShowAllItems(ByRef d As Dictionary)

    Dim x As Variant, y As Variant, i As Long, m As String

    For Each x In d
        i = i + 1
        For Each y In d(x)
          m = d(x)(y)
          Debug.Print "Column: " & i & ", Color: " & y & ", Rows: " & Left(m, Len(m) - 2)
        Next
    Next
End Sub

Result

Selected cells: A3, B4, C2, D1, D7
Row colors:     1, 3, 4, 5, 2, 1, 6, 3, 5, 7

Column: 1, Color: 16772300,   Rows: 1, 3
Column: 1, Color: 6684672,    Rows: 2
Column: 1, Color: 16777215,   Rows: 4, 5, 6
Column: 1, Color: 192,        Rows: 7
Column: 2, Color: 16777215,   Rows: 1, 3, 6
Column: 2, Color: 16772300,   Rows: 2
Column: 2, Color: 192,        Rows: 4, 5
Column: 2, Color: 6684672,    Rows: 7
Column: 3, Color: 16777215,   Rows: 1, 3, 4, 7
Column: 3, Color: 6684672,    Rows: 2
Column: 3, Color: 16772300,   Rows: 5
Column: 3, Color: 192,        Rows: 6
Column: 4, Color: 192,        Rows: 1, 6
Column: 4, Color: 16777215,   Rows: 2
Column: 4, Color: 6684672,    Rows: 3, 5, 7
Column: 4, Color: 16772300,   Rows: 4

Sheet1

0  

I found the answer here: Excel VBA: nested dictionary issue

我在这里找到答案:Excel VBA:嵌套字典问题

I'm a newbie to VBA so I made a mistake in the original code.

我是VBA的新手,所以我在原始代码中犯了一个错误。

I should create a new inner dictionary whenever adding a new key to the outer dictionary.

每当向外部字典添加新密钥时,我都应该创建一个新的内部字典。

So instead of:

所以代替:

Dim Colors As New Scripting.Dictionary

I should have done:

我应该做的:

Dim Colors As Scripting.Dictionary

Then, whenever adding a new key to the outer dictionary, I should do:

然后,每当向外部字典添加新密钥时,我应该这样做:

Set Colors = New Scripting.Dictionary