交集差集，想加入个表头，难度大。。。。

海孩

在期初、期末余额表加一个表头，统计后在减少客户名单、增减客户名单、老客户名单表里自动产生对应的表头。

表头如下：
单位    金额1      金额2    。。。   类别   备注

欢欢

难度不大也

ui

感谢欢欢分享, 学习一下

海孩

谢谢欢欢，搞定，回去测试一下几万条大数据量的速度。另外su45写的代码如何？哪种速度会快些？

Sub suaa()
Dim arr1(), arr2(), arr3()
r = [A65536].End(xlUp).Row
rng1 = Range("A2:A" & r)
rng2 = Range("A2:E" & r)
With Sheets("期末余额表")
    r = .[A65536].End(xlUp).Row
    rng3 = .Range("A2:A" & r)
    rng4 = .Range("A2:E" & r)
End With
rng1 = Application.Transpose(rng1)
rng3 = Application.Transpose(rng3)
For i = 1 To UBound(rng3)
    If UBound(Filter(rng1, rng3(i))) > -1 Then
        n = n + 1
        ReDim Preserve arr3(1 To 5, 1 To n)
        For j = 1 To 5
            arr3(j, n) = rng4(i, j)
        Next
    Else
        m = m + 1
        ReDim Preserve arr2(1 To 5, 1 To m)
        For j = 1 To 5
            arr2(j, m) = rng4(i, j)
        Next
    End If
Next
For i = 1 To UBound(rng1)
    If UBound(Filter(rng3, rng1(i))) = -1 Then
        k = k + 1
        ReDim Preserve arr1(1 To 5, 1 To k)
        For j = 1 To 5
            arr1(j, k) = rng2(i, j)
        Next
    End If
Next
With Sheets("减少的客户名单")
    r = .[A65536].End(xlUp).Row
    If r > 2 Then .Range("A3:C" & r).ClearContents
    .[A3].Resize(k, 5) = Application.Transpose(arr1)
End With
With Sheets("新增的客户名单")
    r = .[A65536].End(xlUp).Row
    If r > 2 Then .Range("A3:C" & r).ClearContents
    .[A3].Resize(m, 5) = Application.Transpose(arr2)
End With
With Sheets("老客户名单")
    r = .[A65536].End(xlUp).Row
    If r > 2 Then .Range("A3:C" & r).ClearContents
    .[A3].Resize(n, 5) = Application.Transpose(arr3)
End With
End Sub

[ 本帖最后由 海孩 于 2008-1-12 13:59 编辑 ]

tmtony

学习学习了

yygyalo

學習中,幾萬條的速度應該很慢吧!