各位大侠，小弟遇到难题，多多帮忙！

Tommy_Tommy

各位大侠，小弟遇到难题，多多帮忙！
例子sheet1：
这是表头   NO1   NO2   　NO3   　NO4   　NO5       NO6
这是内容   12         62                   150                     ####
                    12         62       130                               ####
                  456       140                    150                   ####
                   430                                           234       ####
                   430                 1234                               ####
                ...       ...     ...       ...       ...       ...
条件是当NO1列的单元格有相同的记录时,对比NO1列有相同记录的行的NO2-NO5记录，只要NO2-NO5的记录只要有一项是重复了的，
就把那重复的行记录复制到新的sheet2，原来的sheet1不改变．(这是例子,单元格的数据长度不一)
这样做目的是提取重复了的记录
例子sheet2:
这是表头   NO1   　NO2   　NO3   　NO4   　NO5       NO6
这是内容   12         62                        150                   ####
                  12         62           130                               ####
                ...       ...     ...       ...       ...       ...

Tommy_Tommy

Private   Sub   Worksheet_Activate()
        Dim   i   As   Integer,   d   As   Variant
        Dim   TotCount   As   Integer
        
        Sheet2.Activate
        Cells.ClearContents
        TotCount   =   Sheet1.Range("A65530").End(xlUp).Row
        j   =   2
        With   Sheet1
                .Columns("G:G").ClearContents
                For   i   =   2   To   5
                        .Columns("G:G").ClearContents
                        .Range("A2:F"   &   TotCount).Sort   key1:=.Range("A2"),   key2:=.Cells(2,   i)
                        .Range("G2:G"   &   TotCount).FormulaR1C1   =   "=IF(OR(AND(RC[-6]=R[-1]C[-6],RC[-"   &   7   -   i   &   "]=R[-1]C[-"   &   7   -   i   &   "],RC[-"   &   7   -   i   &   "] <> """"),AND(RC[-6]=R[1]C[-6],RC[-"   &   7   -   i   &   "]=R[1]C[-"   &   7   -   i   &   "],RC[-"   &   7   -   i   &   "] <> """")),1,"""")"
                        d   =   .Range("G2:G"   &   TotCount):   .Range("G2:G"   &   TotCount)   =   d
                        .Range("A2:G"   &   TotCount).Sort   key1:=Sheet1.Range("G2")
                        d   =   .Range("G65530").End(xlUp).Row
                        If   .Range("G2"   &   d)   =   1   Then
                                .Range("A2:F"   &   d).Copy   Range("A"   &   j   &   ":F"   &   j   +   d   -   1)
                                j   =   j   +   d
                        End   If
                Next   i
                .Columns("G:G").ClearContents
        End   With
End   Sub

pureshadow

录一段高级筛选的宏就可以了.

Tommy_Tommy

我试过但,做不出来啊,版主~~~

pureshadow

工具-宏-录制新宏
操作一次高级筛选
结束录制
建立一个窗体按扭
指定到刚才录的宏上