|
我用的是2010版 它是总表和分表回避及提取的 分表数据显示含有6万7千行,红色字段代码 就显示 下标越界,请问该如何解决啊? Sub Test() Dim rgeBase As Range, rge As Range Dim vtBase, vt, vtTmp, i#, j#, k# Set rgeBase = Range("A1").CurrentRegion Set rge = Range("E1").CurrentRegion vtBase = rgeBase vt = rge 'filter the data For i = 3 To UBound(vt) For j = 3 To UBound(vtBase) If vt(i, 1) = vtBase(j, 1) Then If StrComp(vt(j, 2), vtBase(i, 2)) = 0 Then vt(i, 2) = Empty 这段代码 If StrComp(vt(i, 3), vtBase(j, 3)) = 0 Then vt(i, 3) = Empty Exit For End If Next Next 'get the data thar after filter ReDim vtTmp(1 To UBound(vt), 1 To 3) k = 0 For i = 1 To UBound(vt) If i = 1 Or Len(vt(i, 2)) > 0 Or Len(vt(i, 3)) > 0 Then k = k + 1 For j = 1 To 3 vtTmp(k, j) = vt(i, j) Next End If Next Range("M1").Resize(k, 3) = vtTmp End Sub
可以不按照此代码,但要做到对比出新增内容
UeUb2TTa.rar
(4.73 KB, 下载次数: 24)
[此贴子已经被作者于2010-12-8 16:17:02编辑过]
分表和总表的用户号不重复吧! Sub Test() Dim d As
Object Dim ArrF() As
Variant '分表 Dim ArrZ() As
Variant '总表 Dim ArrJG(1 To 100000, 1 To 3) '结果 Dim i&, j&, k&
Set d = CreateObject("scripting.dictionary") ArrF = Range("A2:C" & Range("A2").End(xlDown).Row).Value ArrZ = Range("E2:G" & Range("E2").End(xlDown).Row).Value For i = 1 To
UBound(ArrF) d(ArrF(i, 1)) = i Next i
For i = 1 To
UBound(ArrZ) If Asc(ArrZ(i, 1)) > 0 Then If d.exists(ArrZ(i, 1)) Then j = d(ArrZ(i, 1)) If ArrF(j, 2) <> ArrZ(i, 2) Or ArrF(j, 3) <> ArrZ(i, 3) Then k = k + 1 ArrJG(k, 1) = "'" & ArrZ(i, 1) If ArrF(j, 2) = ArrZ(i, 2) Then ArrJG(k, 2) = Empty Else ArrJG(k, 2) = ArrZ(i, 2) End
If If ArrF(j, 3) = ArrZ(i, 3) Then ArrJG(k, 3) = Empty Else ArrJG(k, 3) = ArrZ(i, 3) End
If End
If Else k = k + 1 ArrJG(k, 1) = "'" & ArrZ(i, 1) ArrJG(k, 2) = ArrZ(i, 2) ArrJG(k, 3) = ArrZ(i, 3) End
If End
If Next i
Range("I:K").Clear Range("I2") = "用户号" Range("J2") = "规格1" Range("K2") = "规格2" Range("I3").Resize(k, 3) = ArrJG End
Sub
|
|