拆分数据

limonet

关键字：table.replacevalue

sdytsxd991122

sdytsxd991122

今铭昔 发表于 2025-4-7 05:43

ynzsvt

拆分与合并去重，结果都在对角下方。已知都在上方。

今铭昔

sdytsxd991122 发表于 2025-4-16 16:12

正则替换有bug，还是老老实实用循环吧。

sdytsxd991122

都市放牧人

学习参与下

yshcy

quqiyuan 发表于 2025-4-6 22:54
代码如下。。。
Sub test()
    arr = Range("a1").CurrentRegion

如果把set d创建字典放在循环之外（跟在sub 之后），就会出错。我按F8看了，在循环j=0 to ubound(crr)时，brr的结果就始终提取arr(i,3)的第一条记录。所以set d必须放在循环之内。向你请教：如果set d这句要紧跟在sub 之后，也就是放在循环之外，代码要如何修改，谢谢。

quqiyuan

yshcy 发表于 2025-7-1 21:12
如果把set d创建字典放在循环之外（跟在sub 之后），就会出错。我按F8看了，在循环j=0 to ubound(crr)时 ...

quqiyuan

代码如下。。。
Sub test()
    Set d = CreateObject("scripting.dictionary")
    Set dic = CreateObject("scripting.dictionary")
    arr = Range("a1").CurrentRegion
    ReDim brr(1 To 1000, 1 To 5)
    For i = 2 To UBound(arr)
        crr = Split(arr(i, 3), "、")
        d.RemoveAll
        For k = 0 To UBound(crr)
            d(crr(k)) = ""
        Next
        For Each k In d.keys
            dic.RemoveAll
            m = m + 1
            brr(m, 1) = arr(i, 1)
            brr(m, 2) = arr(i, 2)
            brr(m, 5) = arr(i, 4)
            brr(m, 4) = k
            For j = 0 To UBound(crr)
                dic(crr(j)) = ""
            Next
            dic.Remove k
            brr(m, 3) = Join(dic.keys, "、")
        Next k
    Next i
    [g2].Resize(m, UBound(brr, 2)) = brr
    Set d = Nothing
    Set dic = Nothing
    Beep
End Sub