[分享]字典+数组的多列数据不重复值查询.应用实例

zz5151353

版主的精華更要收藏

謝謝了 !!!

 

[em23][em23][em23]

 

[em24][em24][em24]

 

[em27][em27][em27]

tiger744990

谢谢彭老师!学习.
rng(i, 5) = rng(i, 5) + dic(k)(4): rng(i, 6) = rng(i, 6) + dic(k)(5): rng(i, 7) = rng(i, 7) + dic(k)(6)
      dic(k) = Array(rng(i, 1), rng(i, 2), rng(i, 3), rng(i, 4), rng(i, 5), rng(i, 6), rng(i, 7))

精妙,,,谢谢.

lj1226189

试了一下按彭兄比楼主的快10倍！

Sub tiger744990()
Dim dic As Object, arr, arr1, i%, j%, n%
Dim aa As Double
aa = Timer
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
n = Cells(65536, 1).End(xlUp).Row
arr = [a1].CurrentRegion.Value
ReDim temp(1 To 10000, 1 To 7)
For i = 2 To n
If Not dic.exists(arr(i, 2) & arr(i, 3)) Then
x = x + 1
dic.Add arr(i, 2) & arr(i, 3), x
temp(x, 1) = arr(i, 1)
temp(x, 2) = arr(i, 2)
temp(x, 3) = arr(i, 3)
temp(x, 4) = arr(i, 4)
temp(x, 5) = arr(i, 5)
temp(x, 6) = arr(i, 6)
temp(x, 7) = arr(i, 7)
Else
u = dic(arr(i, 2) & arr(i, 3))
temp(u, 5) = temp(u, 5) + arr(i, 5)
temp(u, 6) = temp(u, 6) + arr(i, 6)
temp(u, 7) = temp(u, 7) + arr(i, 7)
End If
Next
Sheet2.[a1:g1] = Sheet1.[a1:g1].Value
Sheet2.[a2].Resize(10000, 7) = temp
Set dic = Nothing
Application.ScreenUpdating = True
MsgBox "Total:= " & Format(Timer - aa, "0.00") & "s"
End Sub

冰山上的来客

temp(x, 5) = arr(i, 5) 出现'下标越界'的错误了.

冰山上的来客

不好意思.用错附件了.

彭希仁

QUOTE:

以下是引用冰山上的来客在2007-11-22 13:56:18的发言：
temp(x, 5) = arr(i, 5) 出现'下标越界'的错误了.

是TEMP越界吗?那就是数据太多了,你把数组定义再大些试试

ReDim temp(1 To 65536, 1 To 7)

彭希仁

QUOTE:

以下是引用lj1226189在2007-11-22 13:13:11的发言：

试了一下按彭兄比楼主的快10倍！

Sub tiger744990()
Dim dic As Object, arr, arr1, i%, j%, n%
Dim aa As Double
aa = Timer
Application.ScreenUpdating = False
Set dic = CreateObject("Scripting.Dictionary")
n = Cells(65536, 1).End(xlUp).Row
arr = [a1].CurrentRegion.Value
ReDim temp(1 To 10000, 1 To 7)
For i = 2 To n
If Not dic.exists(arr(i, 2) & arr(i, 3)) Then
x = x + 1
dic.Add arr(i, 2) & arr(i, 3), x
temp(x, 1) = arr(i, 1)
temp(x, 2) = arr(i, 2)
temp(x, 3) = arr(i, 3)
temp(x, 4) = arr(i, 4)
temp(x, 5) = arr(i, 5)
temp(x, 6) = arr(i, 6)
temp(x, 7) = arr(i, 7)
Else
u = dic(arr(i, 2) & arr(i, 3))
temp(u, 5) = temp(u, 5) + arr(i, 5)
temp(u, 6) = temp(u, 6) + arr(i, 6)
temp(u, 7) = temp(u, 7) + arr(i, 7)
End If
Next
Sheet2.[a1:g1] = Sheet1.[a1:g1].Value
Sheet2.[a2].Resize(10000, 7) = temp
Set dic = Nothing
Application.ScreenUpdating = True
MsgBox "Total:= " & Format(Timer - aa, "0.00") & "s"
End Sub

好非常好,学习了.

如果对工作表写入次数很少没有必要加入Application.ScreenUpdating = False,加入之后反而会影响速度.

Sheet2.[a2].Resize(X, 7) = temp 

只有这样处理之后效率才可能比铁耙版主的代码快

[此贴子已经被作者于2007-11-22 14:41:30编辑过]

冰山上的来客

QUOTE:

以下是引用彭希仁在2007-11-22 14:02:32的发言：

是TEMP越界吗?那就是数据太多了,你把数组定义再大些试试

ReDim temp(1 To 65536, 1 To 7)

咱用的是楼主的第一个附件.照您说的修改后,依旧报错.

彭希仁

QUOTE:

以下是引用冰山上的来客在2007-11-22 14:08:29的发言：

咱用的是楼主的第一个附件.照您说的修改后,依旧报错.

难怪,格式错了.那第一个附件是找出重复的值.

第二个附件是合并计算.

tiger744990

嗯,很好的．这种方法,与1楼的龙兄代码的思维方式一致，他用了动态数组．

这句Sheet2.[a2].Resize(10000, 7) = temp，改为Sheet2.[a2].Resize(x, 7) = temp,则更快．

谢谢，彭希仁、lj1226189老师让我对知识巩固了，加深了．我的２楼代码中，的确多了一个For...Next.