[已解决]生产计划明细表日期导入

hwc2ycy

你用这个试试，已经固定工作表了。
然后运行前打开立即窗口，然后运行，看看立即窗口的输出。

che_dream

hwc2ycy 发表于 2012-10-13 08:49
显示NA，应该是两个表的信息有不一致的地方。
因为我是根据那6列关键值来核实的。
要不你把你的表压缩上传 ...

已传附件，谢谢！

hwc2ycy

hwc2ycy

显示有误的只有最后一行数据。呆会再帮你看看。

hwc2ycy

有一部分NA是由于没有考虑到你两边数据行不一致的情况下产生的。

hwc2ycy

好了。
问题都是没有料到你两边的数据不同。

hwc2ycy

1. Sub 导入日期()
   
2.     Dim wb As Workbook
   
3.     Dim sPath As String
   
4.     Dim sFilename As String
   
5.     Dim sWorkbookname As String
   
6.     Dim arr, dic, arrRst
   
7.     Dim irow, i, j, k, sKey As String
   
8.     Dim arrCol
   
9.     Dim sShtName$
   
10.     On Error Resume Next
    
11.     Application.ScreenUpdating = False
    
12.     sFilename = "生产计划明细表.xls"
    
13.     sPath = ThisWorkbook.Path & "" & sFilename
    
14.     sWorkbookname = "生产计划明细表"
    
15.     sShtName = "已完成"
    
16.     If Dir(sPath) = "" Then
    
17.         MsgBox sFilename & "文件不存在"
    
18.         Exit Sub
    
19.     End If
    
20.     Set wb = Workbooks.Item(sFilename)
    
21.     If wb Is Nothing Then
    
22.         Workbooks.Open Filename:=sPath, ReadOnly:=True
    
23.         Worksheets(sShtName).Activate
    
24.     Else
    
25.         Workbooks(sFilename).Activate
    
26.         Worksheets(sShtName).Activate
    
27.     End If
    
28.     'arr = Range("a3").CurrentRegion    '方法一取当前区域
    
29.     irow = Range("a3").End(xlDown).Row      '方法二，先旧最后一行数据行，然后再整行
    
30.     Debug.Print "数据源工作表最末行是" & irow
    
31.     arr = Range("a4:q" & irow)
    
32.     Set dic = CreateObject("scripting.dictionary")
    
33.     arrCol = Array(1, 2, 3, 7, 9, 10)
    
34.     For i = 1 To UBound(arr)
    
35.         sKey = ""
    
36.         For j = 0 To UBound(arrCol)
    
37.             sKey = sKey & arr(i, arrCol(j)) & "|"
    
38.         Next
    
39.         dic(sKey) = arr(i, 15)
    
40.         Debug.Print "源表读取 " & sKey & "  " & dic(sKey)
    
41.     Next
    
42.     Erase arr
    
43.     ActiveWorkbook.Close SaveChanges:=False
    
44.     ThisWorkbook.Activate
    
45.     Worksheets("12345").Select
    
46.     'arr = Range("a3").CurrentRegion    '方法一取当前区域
    
47.     irow = Range("a3").End(xlDown).Row      '方法二，先旧最后一行数据行，然后再整行
    
48.     Debug.Print vbCr
    
49.     Debug.Print "目标工作表的数据末行是" & irow
    
50.     arr = Range("a4:l" & irow)
    
51.     ReDim arrRst(1 To UBound(arr), 1 To 1)  '根据行数重新定义数组大小
    
52.     arrCol = Array(6, 7, 8, 1, 2, 10)
    
53.     For i = 1 To UBound(arr)
    
54.         sKey = ""
    
55.         For j = 0 To UBound(arrCol)
    
56.             sKey = sKey & arr(i, arrCol(j)) & "|"
    
57.         Next
    
58.         If dic.exists(sKey) Then
    
59.             arrRst(i, 1) = Format(dic(sKey), "M月d日")
    
60.             Debug.Print "目标数据读取 " & sKey & "  " & dic(sKey)
    
61.         Else
    
62.             arrRst(i, 1) = ""
    
63.         End If
    
64.         
    
65.     Next
    
66.    
    
67.     Range("k4").Resize(UBound(arrRst), 1) = arrRst
    
68. End Sub

复制代码

hwc2ycy

123.rar (16.66 KB, 下载次数: 35)

2012-10-13 09:49 上传

点击文件名下载附件

che_dream

hwc2ycy 发表于 2012-10-13 09:46

确实可以运行了，但是 在12345表中日期列从1264行到1664行显示#N/A，从1264行向下是没有数据，已完成表中才800多列，不知道会不会有问题。

hwc2ycy

新代码已经改好了。
原来有NA是因为数组维数不对。
你去试试再说吧。