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)。

---