Excel 大型数据集的唯一计数公式

我无法确定如何将

1

或

0

输入相邻单元格，以指示在处理大型数据集时某个值是否唯一。我读过很多实现这一点的方法，但是就我的目的而言，没有一种方法是有效的：我使用的是Excel 2010的实例（因此我在数据透视表中没有独特的计数功能），当我尝试使用PowerPivot时，由于处理限制，它会使我的文件崩溃

在这个StackOverflow问题中：有人建议使用

SUMPRODUCT

或

COUNTIF

，但当我处理50000多行时，这会导致糟糕的性能，文件大小为~35MB，而不是~3MB。我想知道对于大型动态数据集，是否有更好的解决方案，无论是公式还是VBA

我想完成的一个示例是（唯一列为相邻单元格）：

我试图为

COUNTIF

的相同功能编写脚本，但没有成功：

For Each Cell In ThisWorkbook.Worksheets("Overtime & Type Data").Range("Z2:Z" & DataLastRow)
If Worksheets("Overtime & Type Data").Cells(Cell.Row, 26) <> Worksheets("Overtime & Type Data").Cells(Cell.Row - 1, 26) Then
FirstCell = Cell.Row
End If
If (Worksheets("Overtime & Type Data").Range(Cells(FirstCell, 26), Cells(Cell.Row, 26)) = Worksheets("Overtime & Type Data").Range(Cells(Cell.Row, 26))) = True Then
    Cell.Value = 1
Else
    Cell.Value = 0
End If
Next Cell

此工作簿中每个单元格的

。工作表（“加班和类型数据”）。范围（“Z2:Z”和DataLastRow）
如果工作表（“加班和类型数据”）。单元格（Cell.Row，26）工作表（“加班和类型数据”）。单元格（Cell.Row-1，26），则
FirstCell=Cell.Row
如果结束
如果（工作表（“加班和类型数据”）.Range（单元格（FirstCell，26），单元格（Cell.Row，26））=工作表（“加班和类型数据”）.Range（单元格（Cell.Row，26））=True，则
单元格值=1
其他的
单元格。值=0
如果结束
下一个细胞

一种方法是按名称和周进行排序。然后，您可以通过与前一行进行比较来确定任何行的唯一性

如果需要保留顺序，可以先写一列索引号（1、2、3，…）以跟踪顺序。计算完“唯一”后，按索引排序以恢复原始顺序

---

整个过程可以用相对较少的步骤手动完成，也可以用VBA自动完成。

此代码在不到3秒内成功运行了130000行。请调整列字母以适合您的数据集

Sub tgr()

    Const colName As String = "A"
    Const colWeek As String = "B"
    Const colOutput As String = "C"

    Dim ws As Worksheet
    Dim rngData As Range
    Dim DataCell As Range
    Dim rngFound As Range
    Dim collUniques As Collection
    Dim arrResults() As Long
    Dim ResultIndex As Long
    Dim UnqCount As Long

    Set ws = ThisWorkbook.Sheets("Overtime & Type Data")
    Set rngData = ws.Range(colName & 2, ws.Cells(Rows.Count, colName).End(xlUp))
    Set collUniques = New Collection
    ReDim arrResults(1 To rngData.Cells.Count, 1 To 1)

    On Error Resume Next
    For Each DataCell In rngData.Cells
        ResultIndex = ResultIndex + 1
        collUniques.Add ws.Cells(DataCell.Row, colName).Value & ws.Cells(DataCell.Row, colWeek).Value, ws.Cells(DataCell.Row, colName).Value & ws.Cells(DataCell.Row, colWeek).Value
        If collUniques.Count > UnqCount Then
            UnqCount = collUniques.Count
            arrResults(ResultIndex, 1) = 1
        Else
            arrResults(ResultIndex, 1) = 0
        End If
    Next DataCell
    On Error GoTo 0

    ws.Cells(rngData.Row, colOutput).Resize(rngData.Cells.Count).Value = arrResults

End Sub

---

我不确定这对50000个值的效果如何，但它在大约一秒钟内通过1500次

Sub unique()
    Dim myColl As New Collection
    Dim isDup As Boolean
    Dim myValue As String
    Dim r As Long

    On Error GoTo DuplicateValue
    For r = 1 To Sheet1.UsedRange.Rows.Count
        isDup = False
        'Combine the value of the 2 cells together
        ' and add that string to our collection
        'If it is already in the collection it errors
        myValue = Sheet1.Cells(r, 1).Value & Sheet1.Cells(r, 2).Value
        myColl.Add r, myValue
        If isDup Then
            Sheet1.Cells(r, 3).Value = "0"
        Else
            Sheet1.Cells(r, 3).Value = "1"
        End If
    Next
    On Error GoTo 0
    Exit Sub
DuplicateValue:
    'The value is already in the collection so put a 0
    isDup = True
    Resume Next
End Sub

---

几乎任何批量操作都会打破涉及工作表单元格的循环。通过在内存中执行所有计算并在完成后将值全部返回工作表，您可能可以将时间缩短一点

Sub is_a_dupe()
    Dim v As Long, vTMP As Variant, vUNQs As Variant, dUNQs As Object

    Debug.Print Timer
    On Error GoTo bm_Uh_Oh
    Set dUNQs = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")

        vTMP = .Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp)).Value2
        ReDim vUNQs(1 To UBound(vTMP, 1), 1 To 1)

        For v = LBound(vTMP, 1) To UBound(vTMP, 1)
            If dUNQs.Exists(Join(Array(vTMP(v, 1), vTMP(v, 2)))) Then
                vUNQs(v, 1) = 0
            Else
                dUNQs.Add Key:=Join(Array(vTMP(v, 1), vTMP(v, 2))), _
                          Item:=vTMP(v, 2)
                vUNQs(v, 1) = 1
            End If
        Next v

        .Cells(2, 3).Resize(UBound(vUNQs, 1), 1) = vUNQs

    End With

    Debug.Print Timer

bm_Uh_Oh:
    dUNQs.RemoveAll
    Set dUNQs = Nothing
End Sub

以前的经验告诉我，各种数据（以及硬件等）会影响进程的计时，但在我的随机样本数据中，我收到了这些经过的时间

50K记录…0.53秒
130K记录…1.32秒
500K记录…4.92秒

---

你有错误吗？如果有，在哪里？如果没有，发生了什么？我目前有一个运行时1004错误，但我不认为这是我编写的脚本，因为我不知道如何转换if

范围

=

单元格

是

真的

语句非常好！代码挂起在哪里？我注意到的一点是第一行不需要o以“.cells”结尾。第二个if语句中的“=true”被另一个除掉。呸，在我编写代码时，你打败了我。干得好！：）这工作做得很好！感谢您的帮助，您的脚本比我制作的脚本写得干净得多。感谢您提交回复，我接受了@tigeravatar的回复，但今天将测试您的回复！谢谢你的回复！我接受了@tigeravatar的回答，但你的选择也会起作用（尽管有一些调整）。我担心对这么多行数据进行排序会有问题，但这并不可怕。

Sub is_a_dupe()
    Dim v As Long, vTMP As Variant, vUNQs As Variant, dUNQs As Object

    Debug.Print Timer
    On Error GoTo bm_Uh_Oh
    Set dUNQs = CreateObject("Scripting.Dictionary")

    With Worksheets("Sheet1")

        vTMP = .Range(.Cells(2, 1), .Cells(Rows.Count, 2).End(xlUp)).Value2
        ReDim vUNQs(1 To UBound(vTMP, 1), 1 To 1)

        For v = LBound(vTMP, 1) To UBound(vTMP, 1)
            If dUNQs.Exists(Join(Array(vTMP(v, 1), vTMP(v, 2)))) Then
                vUNQs(v, 1) = 0
            Else
                dUNQs.Add Key:=Join(Array(vTMP(v, 1), vTMP(v, 2))), _
                          Item:=vTMP(v, 2)
                vUNQs(v, 1) = 1
            End If
        Next v

        .Cells(2, 3).Resize(UBound(vUNQs, 1), 1) = vUNQs

    End With

    Debug.Print Timer

bm_Uh_Oh:
    dUNQs.RemoveAll
    Set dUNQs = Nothing
End Sub