三列对比删除相同的

quqiyuan

wowo000 发表于 2024-11-29 07:49
尊敬的loirol老师：就是S列的单号俺用逗号隔开了。劳烦你了，谢谢！

我的代码没有管s列的符号，只对i列的符号（","）

wowo000

quqiyuan 发表于 2024-11-29 07:58
我的代码没有管s列的符号，只对i列的符号（","）

尊敬的quqiyuan老师：您的代码运行后有多余的逗号，可否劳烦您去掉多余逗号（单号之间只要一个逗号隔开即可）？谢谢！

wowo000

loirol 发表于 2024-11-29 07:56

衷心感谢您！尊敬的loirol老师！太完美了！谢谢！

quqiyuan

wowo000 发表于 2024-11-29 08:01
尊敬的quqiyuan老师：您的代码运行后有多余的逗号，可否劳烦您去掉多余逗号（单号之间只要一个逗号隔开即 ...

稍作改动，仅供参考。。。

quqiyuan

代码如下。。。。
Sub test()
    Dim wb As Workbook, sht As Worksheet
    Set wb = ThisWorkbook
    Set sht = wb.Sheets("sheet1")
    arr = sht.UsedRange
    For i = 2 To UBound(arr)
        If arr(i, 9) <> Empty Then
            s = Split(arr(i, 9), ",")
            For j = 0 To UBound(s)
                If InStr(arr(i, 19), s(j)) Then
                    sht.Cells(i, 9) = Replace(sht.Cells(i, 9), "," & s(j), "")
                    sht.Cells(i, 9) = Replace(sht.Cells(i, 9), s(j) & ",", "")
                    sht.Cells(i, 9) = Replace(sht.Cells(i, 9), s(j), "")
                End If
            Next
        End If
    Next
    Beep
End Sub

wowo000

quqiyuan 发表于 2024-11-29 08:19
稍作改动，仅供参考。。。

谢谢您！衷心感谢您，尊敬的quqiyuan老师！

dambcer

ykcbf1100

参与一下。。。

ykcbf1100

参与一下，字典

1. Sub ykcbf()   '//2024.11.29
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 19)
   
5.     On Error Resume Next
   
6.     For i = 2 To UBound(arr)
   
7.         d.RemoveAll
   
8.         If arr(i, 19) <> Empty Then
   
9.             If InStr(arr(i, 19), ",") = 0 Then
   
10.                 If InStr(arr(i, 9), arr(i, 19)) Then
    
11.                     Cells(i, 9) = Replace(arr(i, 9) & ",", arr(i, 19) & ",", "")
    
12.                 End If
    
13.             Else
    
14.                 b = Split(arr(i, 19), ",")
    
15.                 For x = 0 To UBound(b)
    
16.                     d(b(x)) = ""
    
17.                 Next
    
18.                 b = Split(arr(i, 9), ",")
    
19.                 st = ""
    
20.                 For x = 0 To UBound(b)
    
21.                     s = b(x)
    
22.                     If Not d.exists(s) Then
    
23.                         st = st & "," & b(x)
    
24.                     End If
    
25.                 Next
    
26.                 Cells(i, 9) = Mid(st, 2)
    
27.             End If
    
28.         End If
    
29.     Next
    
30.     Set d = Nothing
    
31.     MsgBox "OK！"
    
32. End Sub
    

复制代码

yanglinzi

loirol 发表于 2024-11-29 07:16

正则用的好，学习了