用於計算列范圍中的不同值的函數

Question

我試圖在VBA中創建一個函數，當給定一系列值時，將返回這些值的Count Distinct。 例如：

| Column A | |----------| | 1 | | 2 | | 3 | | 3 | | 3 | | 3 | | 4 | | 4 | | 5 | | 5 | | 6 | 行數= 11個不同的值= 6

這是我試圖用來構建我可以在Excel中調用的函數的VBA代碼的結構：

Function CountDistinct(dataRange As Range)

Dim x As Double
x = 0

For i = 1 To dataRange.Rows.Count

x = x + (1 / (CountIf(dataRange, dataRange(i))))

Next i

End Function

我對VBA編程完全不熟悉，所以對於上面代碼中出現的所有明顯的，明顯的錯誤表示道歉，如果它甚至可以被稱為那樣。

我知道還有其他方法可以得出正確的答案，但我有興趣學習如何創建自定義Excel函數。

此外，我的方法背后的偽邏輯如下：

1. 為函數CountDistinct提供一系列單元格dataRange
2. 循環通過范圍
3. 對於范圍中的每個單元格，在該范圍內對該值執行COUNTIF （因此在上面的示例中，行3-6將各自返回4 ，因為數字3在該范圍內出現4次）。
4. 對於范圍中的每個單元格，將1 /（步驟3的結果）添加到結果變量x

| Values | CountIF(Value) | 1/CountIF(Value) | |--------|----------------|-----------------------------| | 1 | 1 | 1 | | 2 | 1 | 1 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 3 | 4 | 0.25 | | 4 | 2 | 0.5 | | 4 | 2 | 0.5 | | 5 | 2 | 0.5 | | 5 | 2 | 0.5 | | 6 | 1 | 1 | | | | SUM of 1/CountIF(Value) = 6 |

這將返回A == 6列中的Count of Distinct值。

Answer 1

第一步：
將Option Explicit添加到所有模塊的標題中。 它將捕獲OneVariable和OneVarlable之間的差異。
讓變量有意義 - 下次看這段代碼時，你知道x和i是什么嗎？

您的計數選項是

1. 用戶工作表功能
2. 保存值，並僅計算與先前值不匹配的值

使用工作表函數，

Option Explicit

Function CountUnique(dataRange As Range) As Long
Dim CheckCell
Dim Counter As Double
Counter = 0

For Each CheckCell In dataRange.Cells
    Counter = Counter + (1 / (WorksheetFunction.CountIf(dataRange, CheckCell.Value)))
Next
' Finally, set your function name equal to the Counter, 
'   so it knows what to return to Excel
CountUnique = Counter
End Function

使用保持跟蹤

...
' check out scripting dictionaries
' much more advanced - Keep it simple for now
...

Answer 2

方式來晚了，但我想我會放入另一個不需要添加引用的VBA選項。

此外，這涉及到excel VBA的一個簡潔功能，我希望我之前學到的很多。

我對此的解決方案使用Collection對象來查找不同的值。

Option Explicit
'^ As SeanC said, adding Option Explicit is a great way to prevent writing errors when starting out.
Public Function CountDistinct(r As Range) As Long
'' DIM = declare in memory

Dim col As Collection
Dim arr As Variant
Dim x As Long
Dim y As Long

Set col = New Collection
'' setting a Variant = Range will fill the Variant with a 2 dimensional array of the values of the range!
arr = r
'' skip the errors that are raised
On Error Resume Next
'' loop over all of the elements.
'' UBound is a built in VBA Function that gives you the largest value of an array.
    For x = 1 To UBound(arr, 1)
        For y = 1 To UBound(arr, 2)
            '' try to add the value in arr to the collection
            col.Add 0, CStr(arr(x, y))

            '' every time the collection runs into a value it has already added,
            '' it will raise an error.
            'uncomment the below to see why we are turning off errors
            'Debug.Print Err.Number, Err.Description

        Next
    Next
'' turn errors back on.
On Error GoTo 0
''set the function name to the value you want the formula to return
CountDistinct = col.Count
'' The next parts should be handled by VBA automatically but it is good practise to explicitly clean up.
Set col = Nothing
Set arr = Nothing
Set r = Nothing
End Function

我希望這可以幫助某人下線。

Answer 3

Sub CountDistinct()
    Dim RunSub As Long
    Dim LastRow As Long
    Dim CurRow As Long
    Dim Unique As Long

        LastRow = Range("A" & Rows.Count).End(xlUp).Row
        Unique = 1

        For CurRow = 2 To LastRow
            If Range("A2:A" & CurRow - 1).Find(Range("A" & CurRow, LookIn:=xlValues)) Is Nothing Then
            Unique = Unique + 1
            Else
            End If
        Next CurRow

        MsgBox Unique & " Unique Values"

End Sub

Answer 4

當然還有其他方法可以用VBA完成。

Public Function CountDistinct(rng As Range) As Long
  Dim i As Long
  Dim Cnt As Double
  Cnt = 0
  For i = 1 To rng.Rows.Count
    Cnt = Cnt + 1 / WorksheetFunction.CountIf(rng, rng(i, 1))
  Next i
  CountDistinct = CLng(Cnt)
End Function

Answer 5

我也會在這里...

Public Function Count_Distinct_In_Column(Rng As Range)
    Count_Distinct_In_Column = _
    Evaluate("Sum(N(countif(offset(" & Rng.Cells(1).Address _
    & ",,,row(" & Rng.Address & "))," & Rng.Address & ")=1))")
End Function

被稱為：

 ? Count_Distinct_In_Column(Range("A2:A12"))

6

Answer 6

此方法應用以下邏輯。

• 將范圍元素放入數組中
• 將數組放入字典中僅用於唯一元素
• 計算字典中的元素（鍵）以獲取唯一元素

在工具 - >引用，參考“Microsoft腳本運行時”下

Option Explicit

Dim lngCounter As Long
Dim dataRange As Range
Dim dictTemp As Dictionary
Dim varTemp As Variant

Sub Test()

Set dataRange = Range(Cells(2, 1), Cells(12, 1))

MsgBox CountDistinct(dataRange), vbInformation + vbSystemModal, "Count Distinct"

End Sub

Public Function CountDistinct(dataRange As Range) As Long

'Populate range into array
If dataRange.Rows.Count < 2 Then
    ReDim varTemp(1 To 1, 1 To 1)
    varTemp(1, 1) = dataRange
Else
    varTemp = dataRange
End If

'Dictionaries can be used to store unique keys into memory
Set dictTemp = New Dictionary

'Add array items into dictionary if they do not exist
For lngCounter = LBound(varTemp) To UBound(varTemp)
    If dictTemp.Exists(varTemp(lngCounter, 1)) = False Then
        dictTemp.Add Key:=varTemp(lngCounter, 1), Item:=1
    End If
Next lngCounter

'Count of unique items in dictionary
CountDistinct = dictTemp.Count

End Function

Answer 7

在Excel 2013中，在數據透視表中使用Distinct Count。