VBGood网站全文搜索 Google

搜索VBGood全站网页(全文搜索)

VB爱好者乐园(VBGood)

 找回密码
 立即注册
搜索
查看: 2462|回复: 6

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

[复制链接]
发表于 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 控件为结束。我当前实现的代码如下:
  1. Option Explicit

  2. Private Sub Form_Load()
  3.   With lsv
  4.     .View = lvwReport
  5.     .Gridlines = True
  6.     .FullRowSelect = True
  7.     .LabelEdit = lvwManual
  8.     .ColumnHeaders.Add , , "物料编码", 900
  9.     .ColumnHeaders.Add , , "物料名称", 2745 '这个要从数据库中读取,为了突出问题的重点,此代码省略了
  10.     .ColumnHeaders.Add , , "旧数量", 800
  11.     .ColumnHeaders.Add , , "新数量", 800
  12.     .ColumnHeaders.Add , , "变化量", 800
  13.   End With

  14. End Sub

  15. Private Sub lstOldFiles_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  16.   Dim i As Byte
  17.   
  18.   For i = 1 To Data.Files.Count
  19.     If LCase(Right(Data.Files(i), 4)) = ".lnp" Then
  20.       lstOldFiles.AddItem Data.Files(i)
  21.     End If
  22.   Next i
  23. End Sub

  24. Private Sub lstNewFiles_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
  25.   Dim i As Byte
  26.   
  27.   For i = 1 To Data.Files.Count
  28.     If LCase(Right(Data.Files(i), 4)) = ".lnp" Then
  29.       lstNewFiles.AddItem Data.Files(i)
  30.     End If
  31.   Next i
  32. End Sub

  33. Private Sub lstOldFiles_KeyDown(KeyCode As Integer, Shift As Integer)
  34.   If lstOldFiles.ListIndex <> -1 Then
  35.     If KeyCode = vbKeyDelete Then
  36.       lstOldFiles.RemoveItem lstOldFiles.ListIndex
  37.     End If
  38.   End If
  39. End Sub

  40. Private Sub lstNewFiles_KeyDown(KeyCode As Integer, Shift As Integer)
  41.   If lstNewFiles.ListIndex <> -1 Then
  42.     If KeyCode = vbKeyDelete Then
  43.       lstNewFiles.RemoveItem lstNewFiles.ListIndex
  44.     End If
  45.   End If
  46. End Sub

  47. Public Function InArray(ByVal sItem As String, sArray() As String) As Boolean
  48.   Dim i As Long
  49.   
  50.   InArray = False
  51.   
  52.   For i = LBound(sArray) To UBound(sArray)
  53.     If sArray(i) = sItem Then
  54.       InArray = True
  55.       Exit For
  56.     End If
  57.   Next i
  58. End Function

  59. Public Sub Sort(sCode() As String, sQuantity() As String)
  60.   Dim i As Long
  61.   Dim j As Long
  62.   Dim ts As String
  63.   
  64.   For i = 1 To UBound(sCode) - 1
  65.     For j = i + 1 To UBound(sCode)
  66.       If sCode(i) > sCode(j) Then
  67.         ts = sCode(i)
  68.         sCode(i) = sCode(j)
  69.         sCode(j) = ts
  70.         
  71.         ts = sQuantity(i)
  72.         sQuantity(i) = sQuantity(j)
  73.         sQuantity(j) = ts
  74.       End If
  75.     Next j
  76.   Next i
  77. End Sub

  78. Private Sub cmdCompare_Click()
  79.   Dim p As Byte
  80.   Dim sLine As String
  81.   Dim i As Long
  82.   Dim n As Long
  83.   
  84.   ReDim sCode1(1 To 100) As String
  85.   ReDim sQuantity1(1 To 100) As String
  86.   ReDim sCode2(1 To 100) As String
  87.   ReDim sQuantity2(1 To 100) As String
  88.   
  89.   '把第1个文件的内容读入第1组数组
  90.   Open lstOldFiles.List(0) For Input As #1
  91.   p = 0
  92.   Do While Not EOF(1)
  93.     Line Input #1, sLine
  94.     p = p + 1
  95.     sCode1(p) = Split(sLine)(0)
  96.     sQuantity1(p) = Split(sLine)(1)
  97.   Loop
  98.   Close #1
  99.   ReDim Preserve sCode1(1 To p)
  100.   ReDim Preserve sQuantity1(1 To p)
  101.   
  102.   '把第2个文件的内容读入第2组数组
  103.   Open lstNewFiles.List(0) For Input As #1
  104.   p = 0
  105.   Do While Not EOF(1)
  106.     Line Input #1, sLine
  107.     p = p + 1
  108.     sCode2(p) = Split(sLine)(0)
  109.     sQuantity2(p) = Split(sLine)(1)
  110.   Loop
  111.   Close #1
  112.   ReDim Preserve sCode2(1 To p)
  113.   ReDim Preserve sQuantity2(1 To p)
  114.   
  115.   '在第1组数组中增加第2组有而第1组没有的物料
  116.   For i = 1 To UBound(sCode2)
  117.     If Not InArray(sCode2(i), sCode1) Then
  118.       ReDim Preserve sCode1(1 To UBound(sCode1) + 1)
  119.       ReDim Preserve sQuantity1(1 To UBound(sQuantity1) + 1)
  120.       sCode1(UBound(sCode1)) = sCode2(i)
  121.       sQuantity1(UBound(sQuantity1)) = "0"
  122.     End If
  123.   Next i
  124.   
  125.   '在第2组数组中增加第1组有而第2组没有的物料
  126.   For i = 1 To UBound(sCode1)
  127.     If Not InArray(sCode1(i), sCode2) Then
  128.       ReDim Preserve sCode2(1 To UBound(sCode2) + 1)
  129.       ReDim Preserve sQuantity2(1 To UBound(sQuantity2) + 1)
  130.       sCode2(UBound(sCode2)) = sCode1(i)
  131.       sQuantity2(UBound(sQuantity2)) = "0"
  132.     End If
  133.   Next i
  134.   
  135.   '排序
  136.   Sort sCode1, sQuantity1
  137.   Sort sCode2, sQuantity2
  138.   
  139.   '比较
  140.   For i = 1 To UBound(sCode1)
  141.     lsv.ListItems.Add , , sCode1(i)
  142.     lsv.ListItems(i).SubItems(2) = sQuantity1(i)
  143.     lsv.ListItems(i).SubItems(3) = sQuantity2(i)
  144.     n = Val(sQuantity2(i)) - Val(sQuantity1(i))
  145.     lsv.ListItems(i).SubItems(4) = IIf(n < 0, CStr(n), IIf(n = 0, "0", "+" & CStr(n)))
  146.   Next i
  147. End Sub
复制代码
此算法的效率是很低的,特别是 InArray 函数的反复调用,有什么方法可以提高效率呢?

点评

InArray用Collection或Dictionary替代?  发表于 2015-1-4 20:13
发表于 2015-1-4 15:35:01 | 显示全部楼层
用数据库能不能满足你的要求?
回复 支持 反对

使用道具 举报

发表于 2015-1-4 15:49:22 | 显示全部楼层
堆排序
回复 支持 反对

使用道具 举报

发表于 2015-1-4 22:42:18 | 显示全部楼层
我做的话,就先把建的数组用safearray结构做处理,读入的数据用快速排序法排序,再用二分法查找,没有就插入,插入的时候用内存拷贝数组的指针,这种复制只复制了字符串的地址,没有对字符串移动。最后把数据写入ListView。

评分

参与人数 1威望 +3 人气 +1 收起 理由
VBProgramFan + 3 + 1 赞一个

查看全部评分

回复 支持 反对

使用道具 举报

 楼主| 发表于 2015-1-5 22:33:13 | 显示全部楼层
wwswwswws 发表于 2015-1-4 22:42
我做的话,就先把建的数组用safearray结构做处理,读入的数据用快速排序法排序,再用二分法查找,没有就插入 ...

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

点评

⊙﹏⊙b  发表于 2015-1-11 11:15
回复 支持 反对

使用道具 举报

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

本帖子中包含更多资源

您需要 登录 才可以下载或查看,没有帐号?立即注册

x
回复 支持 反对

使用道具 举报

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

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

文字版|手机版|小黑屋|VBGood  

GMT+8, 2022-7-4 23:52

VB爱好者乐园(VBGood)
快速回复 返回顶部 返回列表