计算包含文本的唯一值的数量

syn*_*axe 2 excel vba excel-vba

我有以下代码来计算包含字符串的列中的单元格数量"ABC-QR":

Ctr = Application.WorksheetFunction.CountIf(Sheet1.Range("D4:D1500"), "*ABC-QR*")
EU.Cells(16, 3) = Ctr
Run Code Online (Sandbox Code Playgroud)

"ABC-QR"之所以使用,是因为这是不会改变的数据部分.例如,这些单元格中的真实数据"ABC-QR00012345"或其可能具有的任何数字.我想修改我的代码,以便在计算时不包含重复项.

luk*_*e_t 5

首先,您必须在Visual Basic编辑器中的工具 - >引用中启用"Microsoft Scripting Runtime".

您将工作表中的数据分配到一个数组中; 然后将符合字符串条件的所有内容导入字典中,并且不重复.您可以使用该.Exists方法检查字典中的重复项.

编辑:正如@Zev在评论中所指出的,您甚至不需要使用该.Exists方法.您可以将数组元素分配给字典的键,并将项值指定为1.数组中的任何重复值都将覆盖前一个键,因此将自动处理重复项.

一旦重复的所有内容都已导入到字典中,您就可以.Count在字典上使用该属性.这将告诉您在传递到数组的范围内,有多少记录符合您的字符串条件,并且不是重复的.

Option Explicit
Sub countNonDuplicates()
    Dim wb As Workbook, ws As Worksheet
    Dim dict As Scripting.Dictionary
    Dim myValues() As Variant
    Dim lRow As Long, i As Long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets(1)
    Set dict = New Scripting.Dictionary
    lRow = Cells(Rows.Count, 1).End(xlUp).Row
    myValues = Range(Cells(1, 1), Cells(lRow, 1))

    For i = 1 To UBound(myValues, 1)
        If InStr(myValues(i, 1), "ABC-QR") Then dict(myValues(i,1)) = 1 'arbitrary value
    Next i
    MsgBox (dict.Count)
End Sub
Run Code Online (Sandbox Code Playgroud)

上面的内容当前获取最后一行,Column A然后获取范围并将其分配给数组.如果您希望使用其他列,请使用所需的列号更新以下语句(现在使用下面的示例Column D)

lRow = Cells(Rows.Count, 4).End(xlUp).Row
myValues = Range(Cells(1, 4), Cells(lRow, 4))
Run Code Online (Sandbox Code Playgroud)

此外,它目前正在执行上述操作Sheets(1).将工作表编号更改为您需要的编号.

在100,000条记录上,这需要0.2秒才能产生计数.

  • 如果该项目存在,则无需进行显式检查.而不是`If Not dict.Exists ..Then`,你可以简单地说`dict(myValues(i,1))= 1`(因为这个值不重要). (2认同)