应收账数据提取-涉及查询

image.png

image.png

如图所示，我们需要根据数据提取里面的金额和开票单位，到应收明细里面去查找对应的数据，要求是开票单位可以对的上，如果有应收明细开票金额是跟数据提取里面的金额一致，直接提取，没有的话就查找所有两两相加或者三个相加等一系列可能的情况，并提取数据，进行标记。
主要的思想如下：提供一张筛选筛选客户名称的表格，用于将单个客户放进去，最这个表格进行操作；将开票金额列的金额放入数组中，进行循环遍历，以找到符合要求的数据，放入数据提起表格中。


image.png
Sub tiqushuju()
Dim i, j, k, h, l, m, n, p, q, o, s, a, r, c, b As Integer
Dim arr()

b = Sheets("数据提取").Range("b65533").End(xlUp).Row
For i = 2 To 2

    '按照客户筛选出信息，放入筛选客户表
    Sheets("筛选客户名称").Columns("A:N").Delete Shift:=xlToLeft
    Sheets("应收明细").Rows("1:1").AutoFilter
    Sheets("应收明细").Range("$A$1:$N$65533").AutoFilter Field:=4, Criteria1:=Sheets("数据提取").Range("b" & i)
    j = Sheets("应收明细").Range("d65533").End(xlUp).Row
    Sheets("应收明细").Range("A1:N" & j).Copy Sheets("筛选客户名称").Range("A1")
    Sheets("筛选客户名称").Columns("A:N").EntireColumn.AutoFit
    
    '筛选出金额直接对等的数据
    Sheets("筛选客户名称").Rows("1:1").AutoFilter
    Sheets("筛选客户名称").Range("$A$1:$N$8508").AutoFilter Field:=2, Criteria1:=Sheets("数据提取").Range("a" & i)
    
    
    '将金额直接对等的数据复制出来，并在前面标记为1
    k = Sheets("筛选客户名称").Range("a65533").End(xlUp).Row
    
    If k > 1 Then
        h = Sheets("数据提取").Range("i65533").End(xlUp).Row
        Sheets("筛选客户名称").Range("A1:N" & k).Copy Sheets("数据提取").Range("f" & h + 1)
        h = Sheets("数据提取").Range("i65533").End(xlUp).Row
        l = Sheets("数据提取").Range("e65533").End(xlUp).Row
        Sheets("数据提取").Range("e" & l + 1 & ":" & "e" & h) = 1
        Sheets("数据提取").Range("d" & l + 1 & ":" & "d" & h) = Sheets("数据提取").Range("c" & i)
    
    '不存在单独的数据，进一步判断是否是因为里面有两个相加的和等于1的数据
    
    ElseIf k = 1 Then
        Sheets("筛选客户名称").Rows("1:1").AutoFilter
        
        n = Sheets("筛选客户名称").Range("d65533").End(xlUp).Row
        
        If n-1 >= 2 Then
            
            ReDim arr(1 To n - 1)
            For a = 1 To n - 1
                arr(a) = Sheets("筛选客户名称").Range("b" & a + 1).Value()
            Next
    
            '判断是否只存在两个值，且相加等于目标值
            If (UBound(arr) = 2) And (arr(1) + arr(2) = Sheets("数据提取").Range("a" & i)) Then
                
                h = Sheets("数据提取").Range("i65533").End(xlUp).Row
                Sheets("筛选客户名称").Range("A1:N3").Copy Sheets("数据提取").Range("f" & h + 1)
                h = Sheets("数据提取").Range("i65533").End(xlUp).Row
                l = Sheets("数据提取").Range("e65533").End(xlUp).Row
                Sheets("数据提取").Range("e" & l + 1 & ":" & "e" & h) = 2
                Sheets("数据提取").Range("d" & l + 1 & ":" & "d" & h) = Sheets("数据提取").Range("c" & i)
            
            
            ElseIf (UBound(arr) > 2) Then
                '判断是多于两个值，并且找到所有两个相加的等于目标值的数据
                For p = LBound(arr) To (UBound(arr) - 1)
                    For q = p + 1 To (UBound(arr))
                    
                        If arr(p) + arr(q) = Sheets("数据提取").Range("a" & i) Then
                            o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                            Sheets("筛选客户名称").Range("A1:N1").Copy Sheets("数据提取").Range("f" & o + 1)
                            Sheets("筛选客户名称").Range("A" & p + 1 & ":N" & p + 1).Copy Sheets("数据提取").Range("f" & o + 2)
                            Sheets("筛选客户名称").Range("A" & q + 1 & ":N" & q + 1).Copy Sheets("数据提取").Range("f" & o + 3)
                            
                            s = Sheets("数据提取").Range("e65533").End(xlUp).Row
                            o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                            Sheets("数据提取").Range("e" & s + 1 & ": e" & o) = 2
                            Sheets("数据提取").Range("d" & s + 1 & ": d" & o) = Sheets("数据提取").Range("c" & i)
        
                        End If
                    Next
                Next
                
                '三个数值相加
                For p = LBound(arr) To (UBound(arr) - 2)
                
                    For q = p + 1 To (UBound(arr) - 1)
                        
                        For r = q + 1 To (UBound(arr))
                            If arr(p) + arr(q) + arr(r) = Sheets("数据提取").Range("a" & i) Then
                            
                                o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                                Sheets("筛选客户名称").Range("A1:N1").Copy Sheets("数据提取").Range("f" & o + 1)
                                Sheets("筛选客户名称").Range("A" & p + 1 & ":N" & p + 1).Copy Sheets("数据提取").Range("f" & o + 2)
                                Sheets("筛选客户名称").Range("A" & q + 1 & ":N" & q + 1).Copy Sheets("数据提取").Range("f" & o + 3)
                                Sheets("筛选客户名称").Range("A" & r + 1 & ":N" & r + 1).Copy Sheets("数据提取").Range("f" & o + 4)
                                
                                s = Sheets("数据提取").Range("e65533").End(xlUp).Row
                                o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                                Sheets("数据提取").Range("e" & s + 1 & ": e" & o) = 3
                                Sheets("数据提取").Range("d" & s + 1 & ": d" & o) = Sheets("数据提取").Range("c" & i)
            
                            End If
                        Next
                    Next
                Next
                
                
                '4个数值相加
                'For c = LBound(arr) To (UBound(arr) - 3)
                    'For p = LBound(arr) To (UBound(arr) - 2)
                    
                        'For q = p + 1 To (UBound(arr) - 1)
                            
                            'For r = q + 1 To (UBound(arr))
                                'If arr(c) + arr(p) + arr(q) + arr(r) = Sheets("数据提取").Range("a" & i) Then
                                
                                    'o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                                    'Sheets("筛选客户名称").Range("A1:N1").Copy Sheets("数据提取").Range("f" & o + 1)
                                    'Sheets("筛选客户名称").Range("A" & c + 1 & ":N" & c + 1).Copy Sheets("数据提取").Range("f" & o + 2)
                                    'Sheets("筛选客户名称").Range("A" & p + 1 & ":N" & p + 1).Copy Sheets("数据提取").Range("f" & o + 3)
                                    'Sheets("筛选客户名称").Range("A" & q + 1 & ":N" & q + 1).Copy Sheets("数据提取").Range("f" & o + 4)
                                    'Sheets("筛选客户名称").Range("A" & r + 1 & ":N" & r + 1).Copy Sheets("数据提取").Range("f" & o + 5)
                                    
                                    's = Sheets("数据提取").Range("e65533").End(xlUp).Row
                                    'o = Sheets("数据提取").Range("i65533").End(xlUp).Row
                                    'Sheets("数据提取").Range("e" & s + 1 & ": e" & o) = 4
                                    'Sheets("数据提取").Range("d" & s + 1 & ": d" & o) = Sheets("数据提取").Range("c" & i)
                
                                'End If
                            'Next
                        'Next
                    'Next
                'Next
                
            End If
            
            
        End If
    End If
Next




End Sub

    效果如下：
image.png
©著作权归作者所有,转载或内容合作请联系作者
平台声明：文章内容（如有图片或视频亦包括在内）由作者上传并发布，文章内容仅代表作者本人观点，简书系信息发布平台，仅提供信息存储服务。

推荐阅读更多精彩内容