Excel巧设公式（字典+数字） / 开普饭

有个网友提了这样的一个需求：A中有包含重复值的数据，现在需要将重复值所在单元格的值改为公式引用。例如：A6单元格值为3，第一个出现3的单元格为A5，所以将A6公式设置为=$A$5，其他单元格依次类推。

方法1示例代码如下：

Sub Demo1()
    Dim Dic As Object, dKey
    Dim c As Range
    Dim sKey As String
    Set c = [a1].CurrentRegion
    arr = c.Value
    res = arr
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        sKey = arr(i, 1)
        If Dic.exists(sKey) Then
           res(i, 1) = "=" & Dic(sKey)
        Else
            Dic(sKey) = Cells(i, 1).Address
        End If
    Next
    c.Formula = res
    Set Dic = Nothing
End Sub

【代码解析】
第5行代码获取A列数据区域。
第6行代码即将单元格内容加载到数组中。
第7行代码复制一个数组用于保存结果。
第8行代码创建字典对象。
第9~17行循环处理每个数据。
第10行代码读取数组中的值。
如果字典中已经存在相同的键值，那么第12行代码更新结果数组，设置公式，否则第14行代码将新值添加到字典对象中。
第17行代码一次性更新数据区域的公式，注意此处使用的是Formula属性，而不是通常大家经常用的Value属性。

方法2示例代码如下：

Sub Demo２()
    Dim Dic As Object, dKey
    Dim c As Range
    Dim sKey As String
    Set Dic = CreateObject("Scripting.Dictionary")
    For Each c In [a1].CurrentRegion
        sKey = CStr(c.Value)
        If Dic.exists(sKey) Then
            Dic(sKey) = Array(Dic(sKey)(0), Dic(sKey)(1) & "," & c.Address(0, 0))
        Else
            Dic(sKey) = Array(c.Address, "")
        End If
    Next
    If Dic.Count > 0 Then
        For Each dKey In Dic.keys
            If Len(Dic(dKey)(1)) > 0 Then _
            Range(Mid(Dic(dKey)(1), 2)).Formula = "=" & Dic(dKey)(0)
        Next
    End If
    Set Dic = Nothing
End Sub

【代码解析】
与上面示例相同的地方此处不赘述。
这个实现方法与上一个不同之处在于字典的使用方法，和更新公式的方法。
如果字典中已经存在相同的键值，那么第9行代码更新字典中保存的数组，该数组包含两个元素，第一个元素为键值首次出现的单元格地址，第二元素相同内容单元格的地址，有多个相同单元格是，地址之间以逗号分隔。
例如：对于键值“AA”，数组中保存的两个元素为("$A$1",",$A$11,$A$14")，第1个元素为首次出现的单元格地址，第二个为相同内容单元格的全部地址。
如果字典中不存在该键值，第11行代码将新值添加到字典对象中。
第15~18行代码循环遍历字典对象的键值。
如果字典对象中保存的数组的第二个元素（Dic(dKey)(1)）为空，说明数据中该键值只出现一次，无需更新公式，例如A9单元格。
如果第二个元素Dic(dKey)(1)是非空，那么第17行代码将设置重复值所在单元格的公式，数组中第二个元素保存的是单元格的引用地址，注意第一个逗号字符是多余的，需要使用Mid处理一下，第一个元素为首次出现单元格的地址，所以公式为"=" & Dic(dKey)(0)。

Excel巧设公式（字典+数字）

相关推荐