Excel 理解vba脚本字典

我从Google上收集了一段vba代码，如下所示，它标识了多列中的公共单元格值，并将这些公共值放在单独的列中

Sub get_common_value_from_multiple_columns()

Dim a, c As Long, j As Long, e
Set d = CreateObject("Scripting.Dictionary")
Set a = Cells(1, 1).CurrentRegion
c = a.Columns.Count
a.Select

For j = 0 To c - 1:
    For Each e In a.Columns(j + 1).Value
        If d(e) = j _
            Then d(e) = j + 1
    Next e, j

For Each e In d
    If d(e) < j _
        Then d.Remove e
Next e

If d.Count > 0 _
    Then Cells(c + 1).Resize(d.Count) = Application.Transpose(d.keys)
End Sub

---

对于If为True的第一列和excel的第二列，它为False，但如何实现呢？

我无法理解上述函数的工作方式。几个小时过去了，没有人接电话。最后，我得到了一个不同的解决方案，如下所示-

Option Explicit
Public Sub get_common_value_from_multiple_columns()

    Dim data_dictionary As New Scripting.Dictionary
    'Dim data_dictionary As Object
    'Set data_dictionary = CreateObject("Scripting.Dictionary")
    
    Dim columns_count As Long
    Dim iterator As Integer
    Dim dictionary_item As Variant
    Dim selected_cells As Variant
    
    Set selected_cells = Cells(1, 1).CurrentRegion
    columns_count = selected_cells.Columns.Count
    selected_cells.Select
    
    'Populate the dictionary defined earlier
    For iterator = 0 To columns_count - 1:
        For Each dictionary_item In selected_cells.Columns(iterator + 1).Value
            Debug.Print data_dictionary.Item(dictionary_item) = iterator, dictionary_item
            If data_dictionary.Item(dictionary_item) = iterator Then
                data_dictionary.Item(dictionary_item) = iterator + 1
            End If
        Next dictionary_item
    Next iterator
    
    'Remove the unique values
    For Each dictionary_item In data_dictionary
        If data_dictionary.Item(dictionary_item) < iterator Then
            data_dictionary.Remove dictionary_item
        End If
    Next dictionary_item
    
    'Copy the common value to a new columns
    If data_dictionary.Count > 0 Then
        Cells(columns_count + 2).Resize(data_dictionary.Count) = Application.Transpose(data_dictionary.Keys)
    End If
    
End Sub

Option Explicit
Public Sub get_common_value_from_multiple_columns()

    Dim data_dictionary As New Scripting.Dictionary
    'Dim data_dictionary As Object
    'Set data_dictionary = CreateObject("Scripting.Dictionary")
    
    Dim columns_count As Long
    Dim iterator As Integer
    Dim dictionary_item As Variant
    Dim selected_cells As Variant
    
    Set selected_cells = Cells(1, 1).CurrentRegion
    columns_count = selected_cells.Columns.Count
    selected_cells.Select
    
    'Populate the dictionary defined earlier
    For iterator = 0 To columns_count - 1:
        For Each dictionary_item In selected_cells.Columns(iterator + 1).Value
            If Not data_dictionary.Exists(dictionary_item) Then
                data_dictionary.Item(dictionary_item) = 1
            ElseIf data_dictionary.Exists(dictionary_item) Then
                data_dictionary.Item(dictionary_item) = data_dictionary.Item(dictionary_item) + 1
            End If
        Next dictionary_item
    Next iterator
    
    'Remove the unique values
    For Each dictionary_item In data_dictionary
        If data_dictionary.Item(dictionary_item) < iterator Then
            data_dictionary.Remove dictionary_item
        End If
    Next dictionary_item
    
    'Copy the common value to a new columns
    If data_dictionary.Count > 0 Then
        Cells(columns_count + 2).Resize(data_dictionary.Count) = Application.Transpose(data_dictionary.Keys)
    End If
    
End Sub

选项显式
Public Sub从多个列（）获取公共值
Dim data_dictionary作为新脚本。dictionary
“Dim data\u字典作为对象”
'Set data\u dictionary=CreateObject（“Scripting.dictionary”）
Dim列\u按长度计算
作为整数的Dim迭代器
Dim dictionary\u项作为变量
将选定的_单元格变暗为变体
设置所选单元格=单元格（1，1）。CurrentRegion
columns\u count=选定的\u cells.columns.count
所选单元格。选择
'填充前面定义的词典
对于迭代器=0到列\u计数-1：
对于所选单元格.Columns（迭代器+1）中的每个字典\u项.Value
如果不存在数据字典（字典项），则
数据字典项（字典项）=1
ElseIf data\u dictionary.Exists（dictionary\u项）则
数据字典项（字典项）=数据字典项（字典项）+1
如果结束
下一项
下一迭代器
'删除唯一值
对于数据字典中的每个字典项
如果数据\u dictionary.Item（dictionary\u Item）<迭代器，则
数据\u字典。删除字典\u项
如果结束
下一项
'将公共值复制到新列
如果数据\u dictionary.Count>0，则
单元格（列数+2）。调整大小（数据字典数）=应用程序。转置（数据字典键）
如果结束
端接头

这是非常糟糕的代码。如果您想更好地理解Scripting.Dictionary，请使用google for VBA Scripting.Dictionary。如果您想更好地理解如何编写优秀的VBA，请安装免费的奇妙的RubberDuck插件并查看代码检查。在上面的代码中，d（e）使用默认成员方法。应该更正确地写为d项（e）。for循环是坏的，因为在对其值进行操作之前，它不会检查字典中是否存在e。如果代码第一次在循环中失败，我不会感到惊讶。如果您正在学习，那么最好添加对Microsoft脚本运行时的引用，这样您就可以使用en-early-bound引用脚本字典，并获得intellisense的好处。这是代码的源代码

https://www.mrexcel.com/board/threads/please-need-to-find-common-values-among-multiple-columns.915008/考虑引用微软脚本运行库，并声明“代码> d为字典< /代码>，如果您将使用RubDeC鸭：静态代码分析与早期绑定代码工作最佳。Rubberduck还将帮助您安全地将这些单字母变量重命名为更有意义/描述性的变量。还考虑删除<代码> < < /COD>行继承（这些<代码>如果语句要在一行上），并用正确嵌套的循环替换<代码>下E、J < /代码>。（即
Next e
，然后
Next j
-或者只是
Next
和
Next
。但是两个循环体有两个语句；它会修复奇怪的缩进！）我是VBA的一种学习阶段。在第一次运行时，
d（e）=j
如何在之前没有赋值的情况下实现？以及
d（e）
做了什么？
Option Explicit
Public Sub get_common_value_from_multiple_columns()

    Dim data_dictionary As New Scripting.Dictionary
    'Dim data_dictionary As Object
    'Set data_dictionary = CreateObject("Scripting.Dictionary")
    
    Dim columns_count As Long
    Dim iterator As Integer
    Dim dictionary_item As Variant
    Dim selected_cells As Variant
    
    Set selected_cells = Cells(1, 1).CurrentRegion
    columns_count = selected_cells.Columns.Count
    selected_cells.Select
    
    'Populate the dictionary defined earlier
    For iterator = 0 To columns_count - 1:
        For Each dictionary_item In selected_cells.Columns(iterator + 1).Value
            If Not data_dictionary.Exists(dictionary_item) Then
                data_dictionary.Item(dictionary_item) = 1
            ElseIf data_dictionary.Exists(dictionary_item) Then
                data_dictionary.Item(dictionary_item) = data_dictionary.Item(dictionary_item) + 1
            End If
        Next dictionary_item
    Next iterator
    
    'Remove the unique values
    For Each dictionary_item In data_dictionary
        If data_dictionary.Item(dictionary_item) < iterator Then
            data_dictionary.Remove dictionary_item
        End If
    Next dictionary_item
    
    'Copy the common value to a new columns
    If data_dictionary.Count > 0 Then
        Cells(columns_count + 2).Resize(data_dictionary.Count) = Application.Transpose(data_dictionary.Keys)
    End If
    
End Sub