[已解决]选择性复制数据到另一张表

东海飞龙

选择性数据筛选数据到另一张表中，
代码在里面，可能选择sheet2的G2单元格的值为月报的时候，
数据和sheet1表里的数据有点差异，请老师帮指导下，具体见附件。

最佳答案

月排行榜 / 总排行榜

这儿有肥猫

2014-9-27 10:36

{:2812:}

跳转到最佳答案楼层

这儿有肥猫

附件在哪里？

东海飞龙

这儿有肥猫 发表于 2014-9-26 15:47
附件在哪里？

上传附件错误，上传不了，晚上我回家传一次

东海飞龙

这儿有肥猫 发表于 2014-9-26 15:47
附件在哪里？

附件在此

东海飞龙

Sub NewSht()
    Dim Sh As Worksheet
    Dim Arr, k&, Ary, i&
    Dim Dic As Object, Itm

    Set Dic = CreateObject("Scripting.Dictionary")
    Set Sh = ActiveSheet
    Arr = [A1].CurrentRegion
    For k = 2 To UBound(Arr)
        Dic(Arr(k, 6)) = ""
    Next

    For Each Itm In Dic
        Ary = Arr: i = 1
        For k = 2 To UBound(Arr)
            If Arr(k, 6) = Itm Then
                i = i + 1
                Ary(i, 1) = Arr(k, 1)
                Ary(i, 2) = Arr(k, 2)
                Ary(i, 3) = Arr(k, 3)
                Ary(i, 4) = Arr(k, 4)
                Ary(i, 5) = Arr(k, 5)
                Ary(i, 6) = Arr(k, 6)
                Ary(i, 7) = Arr(k, 7)
            End If
        Next
        Sheets.Add after:=Sh
        ActiveSheet.Name = Itm
        ActiveSheet.[A1].Resize(i, 7) = Ary
    Next
    Dic.RemoveAll
End Sub

东海飞龙

已经完成

这儿有肥猫

{:2812:}

这儿有肥猫

都没来得及看。。。
不过这段可以用个循环
For k = 2 To UBound(Arr)
            If Arr(k, 6) = Itm Then
                i = i + 1
                Ary(i, 1) = Arr(k, 1)
                Ary(i, 2) = Arr(k, 2)
                Ary(i, 3) = Arr(k, 3)
                Ary(i, 4) = Arr(k, 4)
                Ary(i, 5) = Arr(k, 5)
                Ary(i, 6) = Arr(k, 6)
                Ary(i, 7) = Arr(k, 7)
            End If
        Next
减少代码
For k = 2 To UBound(Arr)
            If Arr(k, 6) = Itm Then
                i = i + 1
               for j =1 to 7
                    Ary(i, j) = Arr(k, j)
               next
            End If
        Next