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
