数据太多了需要统计 重复个数用VBA

zhang139

目标数去比对 下面数据  斜对比对 重复的个数

zhang139

用这个代码太卡了~
Sub 出错次数()
Application.ScreenUpdating = False
Dim d As Object, arr, brr, i&, j&, k&, s$
arr = Range("a1").CurrentRegion
'MsgBox UBound(arr, 2)
For b = 5 To UBound(arr)
i1 = 0
For i = 2139 To UBound(arr, 2) - 1
If Cells(2, i + 1) = Cells(b, i) Then
i1 = i1 + 1
End If

Next
Cells(b, 9) = i1
Next
Application.ScreenUpdating = True
MsgBox "更新完成"
End Sub

maditate

打开附件，看不懂楼主想干什么。从楼主的代码来看，既然代码前部用了数组，为何在后半部又直接用单元格比较单元格？还直接给单元格赋值？

zhang139

maditate 发表于 2019-6-10 11:23
打开附件，看不懂楼主想干什么。从楼主的代码来看，既然代码前部用了数组，为何在后半部又直接用单元格比较 ...

代码 论坛找的 不知道运用

zhang139

maditate 发表于 2019-6-10 11:23
打开附件，看不懂楼主想干什么。从楼主的代码来看，既然代码前部用了数组，为何在后半部又直接用单元格比较 ...

求大侠帮忙优化

不知道为什么

楼主头像是本人么？呵呵

zhang139

就是比对2个单元格 一样的有多少 统计

maditate

zhang139 发表于 2019-6-10 11:26
求大侠帮忙优化

有你这样求助的吗？数据源上也不说明需要得到什么，网上随便找来一段代码就让别你给你优化？

zopey

zhang139 发表于 2019-6-10 11:39
就是比对2个单元格 一样的有多少 统计

模拟结果 并做说明。

一把小刀闯天下

Option Explicit

Sub test()
  Dim arr, mark, sum  As Long, i As Long, j As Long, k As Long
  mark = [c1:d1].Value
  arr = Range("a2:d2" & Cells(Rows.Count, "b").End(xlUp).Row)
  For i = 1 To UBound(arr, 1)
    For j = 2 To UBound(arr, 2)
      For k = 1 To UBound(mark, 2)
        If arr(i, j) = mark(1, k) Then sum = sum + 1: Exit For
    Next k, j
    arr(i, 1) = sum: sum = 0
  Next
  [a2].Resize(UBound(arr, 1)) = arr
End Sub