请教如何去掉重复值，只保留一个

prowl

希望表里，A列有重复数值，希望去掉重复部分，只保留一个内容，希望达到的要求，打开表格一看就明白了

shiruiqiang

字典嵌套或数组

sdytsxd991122

lizhipei78

shiruiqiang 发表于 2024-7-27 09:24
字典嵌套或数组

针对楼主这个示例，不用这么麻烦

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, r&, dic As Object, vKey
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    For i = 1 To UBound(ar)
        dic(ar(i, 1)) = dic(ar(i, 1)) & " " & ar(i, 2)
    Next i
   
    For Each vKey In dic.keys
        br = Split(dic(vKey))
        For i = 1 To UBound(br)
            r = r + 1
            If i <> 1 Then ar(r, 1) = "" Else ar(r, 1) = vKey
            ar(r, 2) = br(i)
        Next i
    Next
   
    [D1].Resize(r, 2) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

..........

ykcbf1100

数据这么有规律，都用不到字典。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.7.27
   
2.     r = Cells(Rows.Count, 1).End(3).Row
   
3.     arr = [a1].Resize(r, 2)
   
4.     ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
5.     m = 1
   
6.     brr(1, 1) = arr(1, 1): brr(1, 2) = arr(1, 2)
   
7.     For i = 2 To UBound(arr)
   
8.         m = m + 1
   
9.         If arr(i, 1) = arr(i - 1, 1) Then
   
10.             brr(m, 1) = ""
    
11.         Else
    
12.             brr(m, 1) = arr(i, 1)
    
13.         End If
    
14.         brr(m, 2) = arr(i, 2)
    
15.     Next
    
16.     [k:l] = ""
    
17.     [k1].Resize(m, 2) = brr
    
18.     MsgBox "OK！"
    
19. End Sub
    

复制代码

cai2532

留下脚印学习了。

一招秒杀

辅助列，一个简单的公式就搞定了，还要写那么多代码，真是不值得。