删除重复值

言明

诸位老师，，，

根据源sheet数据，在新的sheet达到去除A\B\C\G列重复项
就希望可以达到excel自带”“数据-删除重复项”的效果，，ABCG四列删除重复项

在“达到效果”sheet是利用公式完成，，因为vba实在是小白，，不清楚是否可以达到，，，
如果很难，，还请诸位老师帮忙达到ABCG4列删除重复项的效果，，谢谢

谢谢

gwjkkkkk

Sub TEST3()
  [a1].CurrentRegion.RemoveDuplicates Columns:=Array(2, 3, 4), Header:=xlYes
  ActiveSheet.Sort.SortFields.Clear
  [a1].Sort key1:=Cells(1, 2), Order1:=xlAscending, key2:=Cells(1, 3), Order2:=xlAscending, key3:=Cells(1, 4), Order3:=xlAscending, Header:=xlYes
  Columns(1).Delete
End Sub

gwjkkkkk

请楼主参考附件。。。

言明

gwjkkkkk 发表于 2023-1-9 20:58
请楼主参考附件。。。

哦哦，谢谢老师
那个能麻烦能另新建的sheet吗，，
不覆盖源数据，多谢多谢

gwjkkkkk

请参考附件。。。

言明

gwjkkkkk 发表于 2023-1-9 21:24
请参考附件。。。

您好，，
是我没表达清楚

再麻烦您一下，，，结果copy到已有sheet2中（不是新建），，因为后面还会结合count等函数进行统计，，如果新建，，就要重写公式。。谢谢

你地铁图

言明 发表于 2023-1-9 21:40
您好，，
是我没表达清楚

你把公式要效果也说出来

你地铁图

反向创建字典

Hontyu

..............

做一名学霸

Sub 删除重复行()
    Dim i As Integer, r As Integer, j As Integer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Sheets(Sheets.Count).Delete
    Sheets("源").Copy after:=Sheets(Sheets.Count)
    With Sheets(Sheets.Count)
        r = .Range("A1048576").End(xlUp).Row
        For i = 2 To r
            .Range("E" & i) = .Range("B" & i) & .Range("C" & i) & .Range("D" & i)
        Next

        For j = r To 2 Step -1
            If Application.CountIf(.Columns(5), .Cells(j, 5)) > 1 Then
                .Rows(j).Delete
            End If
        Next
        .Columns(5).Delete
        .Columns(1).Delete
        .Range("A1").Sort KEY1:=.Range("A1"), order1:=1, KEY2:=.Range("B1"), order2:=1, KEY3:=.Range("C1"), order3:=1, Header:=1
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
End Sub



请查收，经测试，无误。