去除重复内容重新从一到二排列

爱上你了

去重复排列.zip (9.03 KB, 下载次数: 16)

2020-1-15 17:59 上传

点击文件名下载附件

爱上你了

请老师们看看指点，谢谢！

orr89

Sub 去重排列()
    Dim dic
    Set dic = CreateObject("scripting.dictionary")
    arr = Range("A2:A" & [A60000].End(xlUp).Row)
    For A列循环 = 2 To UBound(arr)
        dic(arr(A列循环, 1)) = A列循环
    Next
    [B2].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
    Range("B2:B5").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("B2") _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("B2:B" & [B60000].End(xlUp).Row)
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
End Sub

对了请给朵小花

祝洪忠-

=INDEX(A$2:A$18,MATCH(,COUNTIF(B$1:B1,A$2:A$18),))&""
B2输入公式，按住SHift+ctrl不放 按回车

mengrs

=INDEX(A:A,1+MATCH(,COUNTIF(B$1:B1,A$2:A$1000),))&""
B2输入公式，按住SHift+ctrl不放 按回车