这是我的情况:
我正在为我的非营利组织开发一个应用程序,以便跟踪在线购买,我的组织有40多个由国家资助的计划,我们有15个以上的不同站点。因此,您可以从中看到,这意味着每个建筑物有多个程序。
因此,在完成购买后(可以通过计划或网站进行购买),我们必须将报告发送至资金来源,并且他们要求这些报告的方式在从亚马逊购买时特别混乱,因为单个订单可以原来是5项或以上的不同费用,并且报告应与银行对帐单中的每一项费用相匹配。我创建了代码,以找到适合每项指控的合适项目,一切正常,但是我的代码不是防弹的。
如果我有很多价格相同且付款多次的商品,则最终会有太多的组合(我将每个可能的答案存储在一个数组中),并且在试图找出哪一个是正确的组合时数组中的每笔付款有时都会超出数组可以容纳的项目限制。
这是此过程的全部代码:
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim List() As Decimal = {49.03, 10.25, 4.6, 15.4, 30.15, 20.1, 20.1, 20.05, 20.25, 10.07, 9, 9, 9, 9, 9}
Dim Nums() As Decimal = {59.5, 79.35, 106.15}
Dim Sum1 As Decimal = 0
Dim Sum2 As Decimal = 0
For X = 0 To List.Length - 1
Sum1 = Sum1 + List(X)
Next
For X = 0 To Nums.Length - 1
Sum2 = Sum2 + Nums(X)
Next
If Sum1 = Sum2 Then
StatementMatch(List, Nums)
Else
MsgBox("The values doesn't match." & vbCrLf & "The total price of all items is: $" & Sum1.ToString & vbCrLf & "The total of all payments is: $" & Sum2.ToString)
End If
End Sub
在前面的代码中,我手动加载数组List(),其中包含每个项目的价格,数组Nums()是银行对帐单上显示的付款。
在继续执行整个过程之前,我需要验证项目的总金额与付款的总金额相同。
Public Sub StatementMatch(List() As Decimal, Nums() As Decimal)
Dim Test As String = ""
Dim Tot As Decimal = 0
Dim Result(((2 ^ List.Length) - 1), List.Length) As Decimal
Dim Occur(,) As String
For XX = 0 To Result.GetLength(0) - 1
For Y = 0 To Result.GetLength(1) - 1
Result(XX, Y) = 0
Next
Next
Tot = 0
For I = 0 To Result.GetLength(0) - 1
Test = Convert.ToString(I, 2)
Do While Test.Length < List.Length
Test = "0" & Test
Loop
For M = Test.Length - 1 To 0 Step -1
If Test.Substring(M, 1) = 1 Then
Tot = Tot + List(Test.Length - 1 - M)
Result(I, Test.Length - M) = 1
End If
Next
Result(I, 0) = Tot
Tot = 0
Next
Dim Count(Nums.Length - 1) As Integer
For Z = 0 To Count.Length - 1
Count(Z) = 0
Next
For XX = 0 To Result.GetLength(0) - 1
For Y = 0 To Nums.Length - 1
If Result(XX, 0) = Nums(Y) Then
Count(Y) = Count(Y) + 1
End If
Next
Next
Dim Big As Integer = 0
For Z = 0 To Count.Length - 1
If Big < Count(Z) Then
Big = Count(Z)
End If
Next
ReDim Occur(Nums.Length - 1, Big - 1)
Dim CountD(Nums.Length - 1) As Integer
For XX = 0 To CountD.Length - 1
CountD(XX) = 0
Next
For XX = 0 To Occur.GetLength(0) - 1
For Y = 0 To Occur.GetLength(1) - 1
Occur(XX, Y) = "NONE" 'llenar el array con NONE
Next
Next
Dim BinValue As String = ""
For XX = 0 To Result.GetLength(0) - 1
For Y = 0 To Nums.Length - 1
If Result(XX, 0) = Nums(Y) Then
For Z = 1 To List.Length
BinValue = Result(XX, Z).ToString & BinValue
Next
Occur(Y, CountD(Y)) = BinValue
CountD(Y) = CountD(Y) + 1
BinValue = ""
End If
Next
Next
Dim Fill() As ULong = {0}
ProcessValidResults(Occur, Occur.GetLength(0) - 1, Fill, True, List, Nums)
End Sub
前面的代码采用2个数组,然后我创建了第3个数组,其中包含所有可能的结果,称为results(,)是2维数组,在1维中的长度与我将要使用的许多不同组合一样长使用数组List()中的数字,第二个轴与我在列表中的项+ 1一样长,第二个轴的索引0将始终具有组合的结果,其余索引将具有0或1告诉我们是否使用了List()中的该项。这些都是在For I = 0的代码中完成的。
完成此操作后,我创建一个数组count(),该数组将计算多少结果与数组Nums()中的每笔付款相匹配,然后,我比较每个结果中有多少结果付款中的一项,取结果最多的一项,并将其放在变量Big上。这将具有数组Occur(,)的尺寸。因为每笔付款都没有相同数量的可能组合,所以我用“无”填充数组Occur,以便稍后检查那里是否没有组合。 (编写此代码时,我想出了一种方法,可以将稍后要在代码中使用的空值确定值,它不会改变任何内容,只需减少步骤即可)然后创建另一个数组(我认为我是数组迷)成为一个名为CountD()的对象,以记住我已经填充了数组的哪个位置。最后,数组Occur(,)将具有与付款一样多的行(第一维),以及与每次付款的有效组合的最大数量一样多的列。此列将填充一个二进制数字,该数字将与list()上的项一样长
最后,我创建了数组Fill,并将其发送给下一个函数,该函数将处理每个组合,这是事情变得失控的地方。
Private Sub ProcessValidResults(Resultados(,) As String, Rows As Integer, Carry() As ULong, Attempt As Boolean, List() As Decimal, Nums() As Decimal)
Dim Filler As ULong
Dim POS As Integer = 0
For Fill = 0 To List.Length - 1
Filler = Filler * 10 + 1
Next
If Rows = 0 And Attempt = False Then
Dim Final(Resultados.GetLength(1) * Carry.Length - 1) As ULong
Dim Counter As Integer = 0
For XX = 0 To Resultados.GetLength(1) - 1
For Y = 0 To Carry.Length - 1
If Resultados(Rows, XX) <> "NONE" Then
Final(Counter) = Convert.ToInt64(Resultados(Rows, XX)) + Carry(Y)
Else
Final(Counter) = Filler + Carry(Y)
End If
Counter = Counter + 1
Next
Next
For Z = 0 To Final.Length - 1
If Final(Z) = Filler Then
POS = Z + 1
MsgBox(POS)
Exit For
End If
Next
FinalResults(Resultados, POS, List, Nums)
End If
If Rows = 1 Then
Dim Valores1(Resultados.GetLength(1) - 1) As ULong
Dim Valores2(Resultados.GetLength(1) - 1) As ULong
For XX = 0 To Resultados.GetLength(1) - 1
If Resultados(Rows - 1, XX) <> "NONE" Then
Valores1(XX) = Convert.ToInt64(Resultados(Rows - 1, XX))
Else
Valores1(XX) = Filler
End If
If Resultados(Rows, XX) <> "NONE" Then
Valores2(XX) = Convert.ToInt64(Resultados(Rows, XX))
Else
Valores2(XX) = Filler
End If
Next
If Attempt = False Then
Dim Sumas(Valores1.Length * Valores2.Length - 1) As ULong
Dim Counter As Integer = 0
For Val1 = 0 To Valores1.Length - 1
For val2 = 0 To Valores2.Length - 1
Sumas(Counter) = Valores1(Val1) + Valores2(val2)
Counter = Counter + 1
Next
Next
Dim Final((Convert.ToUInt64(Sumas.Length) * Convert.ToUInt64(Carry.Length) - 1)) As ULong
Counter = 0
For XX = 0 To Sumas.Length - 1
For Y = 0 To Carry.Length - 1
Final(Counter) = Sumas(XX) + Carry(Y)
Counter = Counter + 1
Next
Next
For Z = 0 To Final.Length - 1
If Final(Z) = Filler Then
POS = Z + 1
MsgBox(POS)
Exit For
End If
Next
Else
Dim Final(Valores1.Length * Valores2.Length - 1) As ULong
Dim Counter As Integer = 0
For Val1 = 0 To Valores1.Length - 1
For val2 = 0 To Valores2.Length - 1
Final(Counter) = Valores1(Val1) + Valores2(val2)
Counter = Counter + 1
Next
Next
For Z = 0 To Final.Length - 1
If Final(Z) = Filler Then
POS = Z + 1
MsgBox(POS)
Exit For
End If
Next
End If
FinalResults(Resultados, POS, List, Nums)
End If
If Rows >= 2 Then
Dim Valores1(Resultados.GetLength(1) - 1) As ULong
Dim Valores2(Resultados.GetLength(1) - 1) As ULong
For XX = 0 To Resultados.GetLength(1) - 1
If Resultados(Rows - 1, XX) <> "NONE" Then
Valores1(XX) = Convert.ToInt64(Resultados(Rows - 1, XX))
Else
Valores1(XX) = Filler
End If
If Resultados(Rows, XX) <> "NONE" Then
Valores2(XX) = Convert.ToInt64(Resultados(Rows, XX))
Else
Valores2(XX) = Filler
End If
Next
Dim Sumas(Valores1.Length * Valores2.Length - 1) As ULong
Dim Counter As Integer = 0
For Val1 = 0 To Valores1.Length - 1
For val2 = 0 To Valores2.Length - 1
Sumas(Counter) = Valores1(Val1) + Valores2(val2)
Counter = Counter + 1
Next
Next
If Attempt = True Then
ProcessValidResults(Resultados, Rows - 2, Sumas, False, List, Nums)
Else
Dim Final(Sumas.Length * Carry.Length - 1) As ULong
Counter = 0
For XX = 0 To Sumas.Length - 1
For Y = 0 To Carry.Length - 1
Final(Counter) = Sumas(XX) + Carry(Y)
Counter = Counter + 1
Next
Next
ProcessValidResults(Resultados, Rows - 2, Final, False, List, Nums)
End If
End If
End Sub
功能:
ProcessValidResults(Resultados(,) As String, Rows As Integer, Carry() As ULong, Attempt As Boolean, List() As Decimal, Nums() As Decimal)
是一个递归函数,它将自行调用直到完成处理每种组合。数组Results(,)与上一个函数中的Occur(,)相同,即每个付款都有组合的行,Rows告诉我们付款金额,这将确定如何处理信息Carry()是一个新数组,该数组将在每次传递此函数后包含结果,请尝试将其告知我们是否是第一次执行该函数,并以此来知道是否已经处理了值,并且需要包含每次,用List()数组创建Filler来替换以前存储在Occur(,)中的None,并将其发送到下一个函数,该函数将为我们提供用于每个数字的项目,对于数组Nums(),它只是要携带到下一个函数。
在这里,我要做的是将这些均发生的二进制数字转换为整数(直接转换,111为111而不是7),然后开始将每一行的数字与下一行相加,并将其存储到另一个一维数组中。然后,该函数将调用自身并将采用该新数组,并使用另一行中的项目对其进行处理,然后将其放入新数组中并再次对其进行调用,直到完成对所有行的处理为止。
最后,数组Final()将与数组Occur(,)中存在的组合一样长。如果我们说数组Occur为(7,30),则数组Final将为Final(30 ^ 7),在这里一切都崩溃了,因为我将拥有比数组中的项更多的可能组合。
我这样做是因为,然后我可以通过Final()并检查天气,其值已满1,例如Final(123)= 1111111(此数字发生变化,它与项目所在的位数一样多) List()),然后知道该索引具有正确的答案,我将对其进行处理,以了解使用List()的哪些项目来匹配Nums()中的每个数字。
Private Sub FinalResults(Occur(,) As String, POS As Integer, List() As Decimal, Nums() As Decimal)
Dim X As Integer = Occur.GetLength(0)
Dim Y As Integer = Occur.GetLength(1)
Dim FinalPos(Occur.GetLength(0) - 1) As Integer
Dim Expo As Integer
For T = 1 To Occur.GetLength(0)
Expo = Y ^ (X - T)
FinalPos(T - 1) = Math.Ceiling(POS / Expo)
POS = POS - (Expo * (FinalPos(T - 1) - 1))
Next
Dim Txt As String = ""
For Y = 0 To Occur.GetLength(0) - 1
Txt = Txt & (Y + 1).ToString & " ==> "
For X = 0 To Occur.GetLength(1) - 1
Txt = Txt & Occur(Y, X) & " - "
Next
Txt = Txt & vbCrLf
Next
Txt = Txt & vbCrLf
For Z = 0 To FinalPos.Length - 1
Txt = Txt & FinalPos(Z).ToString & " ==> " & Occur(Z, FinalPos(Z) - 1) & vbCrLf
Next
Txt = Txt & vbCrLf & vbCrLf
For X = 0 To List.Length - 1
Txt = Txt & List(X) & " - "
Next
Txt = Txt & vbCrLf & vbCrLf
For Y = 0 To Nums.Length - 1
Txt = Txt & Nums(Y) & " = "
For Z = 0 To List.Length - 1
If Occur(Y, FinalPos(Y) - 1).ToString.Substring(Z, 1) = "1" Then
Txt = Txt & List(List.Length - 1 - Z).ToString & " + "
End If
Next
Txt = Txt & vbCrLf
Next
MsgBox(Txt)
End Sub
这就是我处理Final()数组上的头寸并将其变成用于匹配每笔付款的项的方式。从这一行开始:
Dim Txt As String = ""
它只是为了在MsgBox中显示测试结果。最后,数组Occur(,)和FinalPos()之间的组合可以告诉我正确的答案,Occur(,)具有每种付款的可能组合,而FinalPos()可以告诉我其中哪一个是我需要用于每次付款的那个。
现在的问题是,我需要找到可以容纳越来越多项目的数组并作为替代,其他选择是更改配置上的某些内容以使数组容纳更多项目,或者找出解决此问题的其他方法问题。
如果要测试代码,只需创建一个带有按钮的表单即可。您可以手动添加更多项目和更多付款以进行测试。
谢谢。