简单的逻辑，关于数组和字典问题（可以付费）

zjzyj

Gaudi34 发表于 2021-1-16 22:34
老师您好，我突然发现一个问题，就是段落1和段落2的属性个数不定，可能是2,3个，也可能是4,5个，能否把这 ...

Sub test()
    Dim arr, brr, ds1, ds2, i, m, n, x, k1, k2
    Set ds1 = CreateObject("Scripting.Dictionary")
    Set ds2 = CreateObject("Scripting.Dictionary")
    arr = Sheet1.[A1].CurrentRegion
    For i = 2 To UBound(arr)   '段落1信息装入字典ds1
        k1 = arr(i, 3)
        For n = 4 To UBound(arr, 2)    '后面还需使用n的值
            k1 = k1 & "|" & arr(i, n)
        Next
        ds1(arr(i, 1)) = String(UBound(arr, 2) - 3, "|")   '以起点为关键字，值为空，"|"为分割标记符
        ds1(arr(i, 2)) = k1                                '以终点为关键字，值为属性A1 & A2 & A3...
    Next
    Sheet1.[H1].Resize(1, n - 1) = Application.Index(arr, 1, 0)   '段落1的标题行输出到表格

    arr = Sheet2.[A1].CurrentRegion
    For i = 2 To UBound(arr)      '段落2信息装入字典ds2。以终点作为关键字，值为属性B1 & B2 & B3
        k2 = arr(i, 3)
        For m = 4 To UBound(arr, 2)
            k2 = k2 & "|" & arr(i, m)
        Next
        ds2(arr(i, 2)) = k2
    Next
    For i = 3 To UBound(arr, 2)
        Sheet1.[H1].Offset(0, n + i - 4) = arr(1, i)     '段落2的标题行（属性名）输出到表格
    Next

    ReDim brr(1 To 10000, 1 To UBound(arr, 2) + n - 3)  'n-3为段落1的属性列数
    x = 0:    m = 0
    While ds1.Count > 0 Or ds2.Count > 0
        m = m + 1:  brr(m, 1) = x
        If ds1.Count > 0 And ds2.Count > 0 Then  '当段落1和2都还没处理完时
            k1 = ds1.keys()(0):  k2 = ds2.keys()(0)   '从字典中各取出第一个关键字
            sp = Split(ds1(k1) & "|" & ds2(k2), "|")
            If k1 < k2 Then x = k1: ds1.Remove x      '把较小的那个干掉
            If k2 < k1 Then x = k2: ds2.Remove x
            If k1 = k2 Then x = k1: ds1.Remove x: ds2.Remove x   '当相同时，两个都干掉
        ElseIf ds1.Count > 0 Then      '当只剩段落1时（因为,两个段落的终点可能不一致）
            k1 = ds1.keys()(0)
            sp = Split(ds1(k1), "|")
            x = k1
            ds1.Remove x
        ElseIf ds2.Count > 0 Then   '当只剩段落2时
            k2 = ds2.keys()(0)
            sp = Split(String(n - 3, "|") & ds2(k2), "|")  'n-3为段落1的属性列数
            x = k2
            ds2.Remove x
        End If

        brr(m, 2) = x
        For i = 0 To UBound(sp)
            brr(m, i + 3) = sp(i)
        Next
    Wend
    Sheet1.[H2].Resize(m, UBound(brr, 2)) = brr   '结果输出到表格
End Sub

笨鸟飞不高

Gaudi34 发表于 2021-1-17 12:56
感谢老师，非常感谢您的帮助，解决了我的问题。我私信您了，加您好友了。之前说的付费咨询，我给您转过去 ...

谢谢！！！不需要的！！！论坛解答只是工作之余的爱好而已！！

Gaudi34

笨鸟飞不高 发表于 2021-1-17 14:47
谢谢！！！不需要的！！！论坛解答只是工作之余的爱好而已！！

哇，真是太无私了，感动

boy8199

看不懂，想要干什么， 好像 用公式 就能解决。

boy8199

搞什么属性，看了半天  是 跨 段  或者 说 “开始段”   “结束段” 在哪个位置的问题。