[已解决]如何将表三数据从表一、表二筛选后写入表四？（已解决）

chuxue

根据表三代码

从表一

表二

选出代码相同的结果，填到表四里面，求教。

biaoyi.rar (7.45 KB, 下载次数: 19)

2013-12-30 14:57 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

爱疯

2013-12-31 22:36

Sub Click()
    Dim A, B, C, x, d, i, s
        
    A = Sheet1.Range("a1").CurrentRegion
    B = Sheet2.Range("a1").CurrentRegion
    C = Sheet3.Range("a1").CurrentRegion
    With Sheet4
        .Range("a:f").NumberFormat = "@"
        .Range("a2:f65536").ClearContents
    End With

    Set d = CreateObject("scripting.dictionary")
    For i = 2 To UBound(C)
        d(C(i, 1)) = ""
    Next i

    '表1
    s = 0
    ReDim x(1 To UBound(A), 1 To 3)
    For i = 2 To UBound(A)
        If d.exists(A(i, 3)) Then
            s = s + 1
            x(s, 1) = A(i, 1)
            x(s, 2) = A(i, 2)
            x(s, 3) = A(i, 3)
        End If
    Next i
    If s Then Sheet4.Range("a2").Resize(s, UBound(x, 2)) = x

    '表2
    s = 0
    ReDim x(1 To UBound(B), 1 To 3)
    For i = 2 To UBound(B)
        If d.exists(B(i, 9)) Then
            s = s + 1
            x(s, 1) = B(i, 1)
            x(s, 2) = B(i, 2)
            x(s, 3) = B(i, 9)
        End If
    Next i
    If s Then Sheet4.Range("d2").Resize(s, UBound(x, 2)) = x
   
End Sub
(, 下载次数: 14)

上传

点击文件名下载附件

跳转到最佳答案楼层

yewei113

研究一下

大海无情

chuxue

yewei113 发表于 2013-12-30 15:19
研究一下

期待您的指教，谢谢

chuxue

需要，希望指教

chuxue

很着急，近万行数据实在雾水，恳请行家指教，谢谢

szntt

也正想知道

chuxue

为什么我总是等不来高手的指教呢

chuxue

多谢指教

chuxue

szntt 发表于 2013-12-31 12:49
也正想知道

一起等待好心人帮助吧