急需在现求助!!!筛选列举产品对应的各类信息..

dasly123

求助--急11.13.zip (25.24 KB, 下载次数: 12)

2019-11-13 02:28 上传

点击文件名下载附件

sub麻辣君

附件里字典都会写，不会写这个筛选？

爱疯

能否说明一下
比如，产品对应表D3，没看明白7是怎么算出来的？

dasly123

爱疯 发表于 2019-11-14 09:24
能否说明一下
比如，产品对应表D3，没看明白7是怎么算出来的？

敲错了 应该是数字5才对

爱疯

Dim d


Sub test()
    Dim A, i, j
    Call test2
    Sheets(1).Select
    A = Range("a1").CurrentRegion

    '填补合并单元格的空白
    For j = 3 To UBound(A, 2)
        If A(1, j) = "" Then A(1, j) = A(1, j - 1)
    Next j

    '查询
    For i = 3 To UBound(A)
        If A(i, 2) <> "" Then
            '读字典
            For j = 3 To UBound(A, 2)
                If d.exists(A(1, j)) Then
                    If d(A(1, j)).exists(A(2, j)) Then
                        If d(A(1, j))(A(2, j)).exists(A(i, 2)) Then
                            A(i, j) = d(A(1, j))(A(2, j))(A(i, 2))
                        End If
                    End If
                End If
            Next j

            '求总共
            For j = 3 To UBound(A, 2) Step 4
                A(i, j) = A(i, j + 1) + A(i, j + 2) + A(i, j + 3)
            Next j
        End If
    Next i

    [a1].Resize(UBound(A), UBound(A, 2)) = A
End Sub


'写字典
Sub test2()
    Dim A, i, j
    Sheets(3).Select
    A = Range("a1").CurrentRegion
    Set d = CreateObject("scripting.dictionary")

    For i = 2 To UBound(A)
        A(i, 2) = Right(A(i, 2), 3)
        If Not d.exists(A(i, 2)) Then Set d(A(i, 2)) = CreateObject("scripting.dictionary")    'B列
        If Not d(A(i, 2)).exists(A(i, 3)) Then Set d(A(i, 2))(A(i, 3)) = CreateObject("scripting.dictionary")    'C列
        For j = 5 To UBound(A, 2)
            If A(i, j) <> "" Then d(A(i, 2))(A(i, 3))(A(i, j)) = A(i, 4)                'E:J列
        Next j
    Next i

End Sub




1.rar (32.73 KB, 下载次数: 8)

2019-11-14 10:28 上传

点击文件名下载附件

和1楼结果不同，你看看下比如哪儿应该是多少，再来改