字典求简化，是否可在item里直接拆分 处理后 再合并呢

ykcbf1100

jerry3770 发表于 2024-7-29 17:30
我改成同样的机型后  这里好像无法去除重复项，还能优化吗  老师！！

那对原数据还得再拆分一下。
改好了。。。

quqiyuan

按照楼主后面要求，每个单元格里也排重，用了双字典，仅供参考。。。

ykcbf1100

更新一下。。。

1. Sub ykcbf()   '//2024.7.29
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     r = Cells(Rows.Count, 1).End(3).Row
   
4.     arr = [a1].Resize(r, 2)
   
5.     ReDim brr(1 To UBound(arr), 1 To 2)
   
6.     For i = 3 To UBound(arr)
   
7.         s = arr(i, 1)
   
8.         If Not d.exists(s) Then
   
9.             m = m + 1
   
10.             d(s) = m
    
11.             brr(m, 1) = arr(i, 1)
    
12.             b = Split(arr(i, 2), "/")
    
13.             brr(m, 2) = b(0)
    
14.             For x = 1 To UBound(b)
    
15.                 brr(m, 2) = IIf(InStr(brr(m, 2), b(x)), brr(m, 2), brr(m, 2) & "/" & b(x))
    
16.             Next
    
17.         Else
    
18.             r = d(s)
    
19.             brr(r, 2) = IIf(InStr(brr(r, 2), arr(i, 2)), brr(r, 2), brr(r, 2) & "/" & arr(i, 2))
    
20.         End If
    
21.     Next
    
22.     [d3:e10000] = ""
    
23.     [d3].Resize(m, 2) = brr
    
24.     MsgBox "OK！"
    
25. End Sub
    

复制代码

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
   
    ar = [A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        If Not dic.exists(ar(i, 1)) Then
            dic(ar(i, 1)) = ar(i, 2)
        Else
            dic(ar(i, 1)) = dic(ar(i, 1)) & "/" & ar(i, 2)
        End If
    Next i
   
    [D1].CurrentRegion.Offset(1).Clear
    [D2].Resize(dic.Count, 2) = Application.Transpose(Array(dic.keys, dic.items))
   
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

参与一下。。。

jerry3770

zpy2 发表于 2024-7-29 17:42
//select * from Sheet1 limit 20;
cli_split_data~Sheet1~\/~机型;
select 料号,replace(group_concat ...

感谢老师指导，SQL 是好  但它与EXCEL的兼容不好 。

jerry3770

ykcbf1100 发表于 2024-7-29 18:13
那对原数据还得再拆分一下。
改好了。。。

结果正确 ！！谢谢老师  祝您生活愉快。我再学习下您的拆分技术

jerry3770

quqiyuan 发表于 2024-7-29 18:17
按照楼主后面要求，每个单元格里也排重，用了双字典，仅供参考。。。

谢谢老师指导   是我的想法  我就是无法用代码表达。

jerry3770

gwjkkkkk 发表于 2024-7-29 20:14
参与一下。。。

谢谢老师指导  谢谢参与，您的结果还需去除重复项才是我要的，已经解决了。谢谢

zpy2

jerry3770 发表于 2024-7-30 09:29
感谢老师指导，SQL 是好  但它与EXCEL的兼容不好 。

这个不是标准sql,有自定义函数，需要在线sql上执行。

https://e.anyoupin.cn/EData/?s=1312