如何去掉每行的重复数

中条山

工作簿1.rar (7.03 KB, 下载次数: 12)

2024-12-22 18:05 上传

点击文件名下载附件

gwjkkkkk

如果有重复，全部去掉？

quqiyuan

案例都不做一个？？？

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, br, i&, j&, k&, dic() As New Dictionary, vKey
   
    Application.ScreenUpdating = False
    ReDim dic(2)
   
    With Worksheets(1)
    ar = Range(.[A1], .UsedRange).Value
        For i = 1 To UBound(ar)
            dic(0).RemoveAll: dic(1).RemoveAll
            For j = 1 To UBound(ar, 2)
                If Len(ar(i, j)) Then
                    br = Split(ar(i, j), ".")
                    For k = 0 To UBound(br)
                        dic(0)(br(k)) = dic(0)(br(k)) + 1
                        If dic(0)(br(k)) > 1 Then dic(1)(br(k)) = Empty
                    Next k
                End If
            Next j
            If dic(1).Count Then
                For j = 1 To UBound(ar, 2)
                    If Len(ar(i, j)) Then
                        br = Split(ar(i, j), ".")
                        dic(2).RemoveAll
                        For k = 0 To UBound(br)
                            dic(2)(br(k)) = Empty
                        Next k
                        For Each vKey In dic(2)
                            If dic(1).Exists(vKey) Then dic(2).Remove vKey
                        Next
                        ar(i, j) = Join(dic(2).Keys, ".")
                    End If
                Next j
            End If
        Next i
        .[A1].Resize(UBound(ar), UBound(ar, 2)) = ar
    End With
   
    Erase dic
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

请参考附件。。。

中条山

第1行：6,13,5,18,21,22,2,11,12,9,27

ykcbf1100

猜一个。

行去重排序，ArrayList法，结果在表2

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.12.22
   
2.     Application.ScreenUpdating = False
   
3.     Set List = CreateObject("System.Collections.ArrayList")
   
4.     With Sheets("Sheet1")
   
5.         r = .UsedRange.Rows.Count
   
6.         c = .UsedRange.Columns.Count
   
7.         arr = .[a1].Resize(r, c)
   
8.     End With
   
9.     ReDim brr(1 To r, 1 To 1)
   
10.     On Error Resume Next
    
11.     For i = 1 To UBound(arr)
    
12.         List.Clear
    
13.         m = m + 1
    
14.         For j = 1 To UBound(arr, 2)
    
15.             If arr(i, j) <> Empty Then
    
16.                 st = Split(arr(i, j), ".")
    
17.                 For x = 0 To UBound(st)
    
18.                     If Not List.Contains(Val(st(x))) Then List.Add Val(st(x))
    
19.                 Next
    
20.             End If
    
21.         Next
    
22.         List.Sort
    
23.         brr(m, 1) = Join(List.toArray, ".")
    
24.     Next
    
25.     With Sheets("Sheet2")
    
26.         .UsedRange.ClearContents
    
27.         .[a1].Resize(m, 1) = brr
    
28.     End With
    
29.     Set List = Nothing
    
30.     Application.ScreenUpdating = True
    
31.     MsgBox "OK！"
    
32. End Sub
    
33. 
    

复制代码

ynzsvt

是每行独立的处理吗，是的话，给出一行的起始和结果。