跨表对比的检查复制功能实现

yniu88

附件中两个文件：说明：
1、“订单汇总表”是数据源文件。“订单汇总表-分拆”是放在同一个目录下的根据前一个文件进行分拆的文件。
2、由于目前是手动分拆产品物料，所以需要随时对比订单汇总表里面是否有新订单变化，有变化就将该行新订单信息（A-F列增加到分拆表上）。具体一点说：


需求：
根据订单汇总表文件A列的订单分序号，逐一对比“订单汇总表-分拆”里面的A列数据，如果订单分序号已经在订单汇总表-分拆文件的对应A列出现，则默认已经完成分拆。
如果没有，进一步判断未完成数量F列是否为零，如果为零则跳过，比较下一条数据。如果不为零，则说明分拆表存在遗漏，那么将该遗漏的那条数据复制到最下面空白行位置。如果存在重复的订单分序号（意味着前面分拆工作出现重复，则再最下面空白一行出现一条错误提示信息）。
入门新丁，求各位前辈指点。
谢谢先！

桌面.rar (3.74 KB, 下载次数: 18)

2013-5-11 23:11 上传

点击文件名下载附件

yniu88

麻烦各位指点一下思路。谢谢了！

yniu88

麻烦大家指点一下。谢谢！

lzyamo3057

不知道是不是这个意思。试试看吧。

1. Sub text()
   
2.     Dim wb As Workbook
   
3.     Dim i As Integer, rng As Range, d, arr, brr
   
4.     Application.DisplayAlerts = False
   
5.     Application.ScreenUpdating = False
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     Set wb = Workbooks.Open(ThisWorkbook.Path & "\订单汇总表-分拆.xls")
   
8.     arr = wb.Sheets(1).Range("a1").CurrentRegion
   
9.     brr = Sheet1.Range("a1").CurrentRegion
   
10.     If UBound(arr) > 1 Then
    
11.         For i = 2 To UBound(arr)
    
12.             d(arr(i, 1)) = ""
    
13.         Next
    
14.     End If
    
15.     endrow = Sheet1.[a65536].End(xlUp).Row
    
16.     For i = 2 To UBound(brr)
    
17.         endrow1 = wb.Sheets(1).Range("a65536").End(xlUp).Row + 1
    
18.         If d.exists(brr(i, 1)) = False Then
    
19.             If brr(i, 6) <> 0 Then
    
20.                 Sheet1.Rows(i).Copy wb.Sheets(1).Cells(endrow1, 1)
    
21.             End If
    
22.         End If
    
23.     Next
    
24.     wb.Close True
    
25.     Set d = Nothing
    
26.     Application.ScreenUpdating = True
    
27.     Application.DisplayAlerts = True
    
28. End Sub
    
29. 
    

复制代码

yniu88

太感谢了！

soldier_shi

bu cuo de dong xi

bpw0258

学习了,谢谢分享!