材料表对比的最高效率算法

VBProgramFan · 发表于 2015-1-4 10:32:08

本帖最后由 VBProgramFan 于 2015-1-4 10:38 编辑

在工程中我们需要把计划用的材料和实际用的材料做对比，假设文件格式如下：
一行一个材料，第一列是材料编码（8位数字），第二列是该材料的数量（目前为整数，不排除以后有小数的可能，所以为了避免处理浮点类型误差的麻烦，该代码用字符串来存储），用一个空格分开，以下是一个示例：

01000203 1
02000101 1
02000201 17
02000401 15
02000501 6
02000502 6
02000601 16
02000701 800
02000801 12
02000901 60
02001201 3500
02001301 680
02001401 160
02001501 17
04000102 214
04000103 72
04000108 2
04000301 286
04000401 2002
06000101 1
06000201 200
06000202 500
06000301 180
06000501 0
06000601 3
06000701 3
06001001 10
06001101 10
06001301 50
06001401 50
06001501 70
06001601 100
06001701 80
06002101 2
06002301 160
06002601 20

处理过程以拖动文件进 listbox 开始（目前只做了对比第一个，以后要做批量的）。
处理过程以添加结果到 ListView 控件为结束。我当前实现的代码如下：

Option Explicit
Private Sub Form_Load()
With lsv
.View = lvwReport
.Gridlines = True
.FullRowSelect = True
.LabelEdit = lvwManual
.ColumnHeaders.Add , , "物料编码", 900
.ColumnHeaders.Add , , "物料名称", 2745 '这个要从数据库中读取，为了突出问题的重点，此代码省略了
.ColumnHeaders.Add , , "旧数量", 800
.ColumnHeaders.Add , , "新数量", 800
.ColumnHeaders.Add , , "变化量", 800
End With
End Sub
Private Sub lstOldFiles_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Byte
For i = 1 To Data.Files.Count
If LCase(Right(Data.Files(i), 4)) = ".lnp" Then
lstOldFiles.AddItem Data.Files(i)
End If
Next i
End Sub
Private Sub lstNewFiles_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim i As Byte
For i = 1 To Data.Files.Count
If LCase(Right(Data.Files(i), 4)) = ".lnp" Then
lstNewFiles.AddItem Data.Files(i)
End If
Next i
End Sub
Private Sub lstOldFiles_KeyDown(KeyCode As Integer, Shift As Integer)
If lstOldFiles.ListIndex <> -1 Then
If KeyCode = vbKeyDelete Then
lstOldFiles.RemoveItem lstOldFiles.ListIndex
End If
End If
End Sub
Private Sub lstNewFiles_KeyDown(KeyCode As Integer, Shift As Integer)
If lstNewFiles.ListIndex <> -1 Then
If KeyCode = vbKeyDelete Then
lstNewFiles.RemoveItem lstNewFiles.ListIndex
End If
End If
End Sub
Public Function InArray(ByVal sItem As String, sArray() As String) As Boolean
Dim i As Long
InArray = False
For i = LBound(sArray) To UBound(sArray)
If sArray(i) = sItem Then
InArray = True
Exit For
End If
Next i
End Function
Public Sub Sort(sCode() As String, sQuantity() As String)
Dim i As Long
Dim j As Long
Dim ts As String
For i = 1 To UBound(sCode) - 1
For j = i + 1 To UBound(sCode)
If sCode(i) > sCode(j) Then
ts = sCode(i)
sCode(i) = sCode(j)
sCode(j) = ts
ts = sQuantity(i)
sQuantity(i) = sQuantity(j)
sQuantity(j) = ts
End If
Next j
Next i
End Sub
Private Sub cmdCompare_Click()
Dim p As Byte
Dim sLine As String
Dim i As Long
Dim n As Long
ReDim sCode1(1 To 100) As String
ReDim sQuantity1(1 To 100) As String
ReDim sCode2(1 To 100) As String
ReDim sQuantity2(1 To 100) As String
'把第1个文件的内容读入第1组数组
Open lstOldFiles.List(0) For Input As #1
p = 0
Do While Not EOF(1)
Line Input #1, sLine
p = p + 1
sCode1(p) = Split(sLine)(0)
sQuantity1(p) = Split(sLine)(1)
Loop
Close #1
ReDim Preserve sCode1(1 To p)
ReDim Preserve sQuantity1(1 To p)
'把第2个文件的内容读入第2组数组
Open lstNewFiles.List(0) For Input As #1
p = 0
Do While Not EOF(1)
Line Input #1, sLine
p = p + 1
sCode2(p) = Split(sLine)(0)
sQuantity2(p) = Split(sLine)(1)
Loop
Close #1
ReDim Preserve sCode2(1 To p)
ReDim Preserve sQuantity2(1 To p)
'在第1组数组中增加第2组有而第1组没有的物料
For i = 1 To UBound(sCode2)
If Not InArray(sCode2(i), sCode1) Then
ReDim Preserve sCode1(1 To UBound(sCode1) + 1)
ReDim Preserve sQuantity1(1 To UBound(sQuantity1) + 1)
sCode1(UBound(sCode1)) = sCode2(i)
sQuantity1(UBound(sQuantity1)) = "0"
End If
Next i
'在第2组数组中增加第1组有而第2组没有的物料
For i = 1 To UBound(sCode1)
If Not InArray(sCode1(i), sCode2) Then
ReDim Preserve sCode2(1 To UBound(sCode2) + 1)
ReDim Preserve sQuantity2(1 To UBound(sQuantity2) + 1)
sCode2(UBound(sCode2)) = sCode1(i)
sQuantity2(UBound(sQuantity2)) = "0"
End If
Next i
'排序
Sort sCode1, sQuantity1
Sort sCode2, sQuantity2
'比较
For i = 1 To UBound(sCode1)
lsv.ListItems.Add , , sCode1(i)
lsv.ListItems(i).SubItems(2) = sQuantity1(i)
lsv.ListItems(i).SubItems(3) = sQuantity2(i)
n = Val(sQuantity2(i)) - Val(sQuantity1(i))
lsv.ListItems(i).SubItems(4) = IIf(n < 0, CStr(n), IIf(n = 0, "0", "+" & CStr(n)))
Next i
End Sub

复制代码

此算法的效率是很低的，特别是 InArray 函数的反复调用，有什么方法可以提高效率呢？

19900603 · 发表于 2015-1-4 15:35:01

用数据库能不能满足你的要求？

shamying · 发表于 2015-1-4 15:49:22

堆排序

wwswwswws · 发表于 2015-1-4 22:42:18

我做的话，就先把建的数组用safearray结构做处理，读入的数据用快速排序法排序，再用二分法查找，没有就插入，插入的时候用内存拷贝数组的指针，这种复制只复制了字符串的地址，没有对字符串移动。最后把数据写入ListView。

VBProgramFan · 发表于 2015-1-5 22:33:13

wwswwswws 发表于 2015-1-4 22:42
我做的话，就先把建的数组用safearray结构做处理，读入的数据用快速排序法排序，再用二分法查找，没有就插入 ...

链表的插入我只会用 C 和 Pascal，不会用 Basic 来实现，呵呵

wwswwswws · 发表于 2015-1-9 22:47:58

给你做了一个，主要用到HACK安全数组，内存拷贝，快速排序，二分法查找等，但是要说的是：如果你的材料表的材料编码就是这么长的话，建议读入的时候，直接把编码和数量都读成Long型数，那样做起来比现在还要快，这种方法一般是用于字符串比较长的情况

wwswwswws · 发表于 2015-1-31 20:25:01

今天又看到这个题目，发现自己写的程序有问题，数据量大了，简直就是恶梦。这几天研究HASH CODE，这个题目最后的办法就是用hash，就是acme_pjz 大侠说的 InArray用Collection或Dictionary替代。前两天写了一个用hash来处理的例程，10000条对10000条，IDE模式下从读入文件到全部在ListView中显示出来用时416ms，最快312ms。

		自动登录	找回密码
密码			立即注册

VBGood网站全文搜索

[讨论] 材料表对比的最高效率算法

点评

评分

点评

本帖子中包含更多资源