关于根据条件从其他工作薄引用的问题，求助大神

ljpassport

uynayna 发表于 2017-9-6 13:50
d1(crr(i, 2)) = crr(i, 5)  改为 d1(crr(i, 1)) = crr(i, 4) 数组区域也要改啊。

把代码里面的都改了 对吧

ljpassport

uynayna 发表于 2017-9-6 13:50
d1(crr(i, 2)) = crr(i, 5)  改为 d1(crr(i, 1)) = crr(i, 4) 数组区域也要改啊。

不行了呢 出现错误了

ljpassport

uynayna 发表于 2017-9-6 13:50
d1(crr(i, 2)) = crr(i, 5)  改为 d1(crr(i, 1)) = crr(i, 4) 数组区域也要改啊。

不行了呢 出现错误了

这个应该先执行把编码搞过来 再执行引用填充吧

uynayna

实在不能解决，就重新发一次附件。

ljpassport

uynayna 发表于 2017-9-6 14:32
实在不能解决，就重新发一次附件。

Desktop.rar (29.29 KB, 下载次数: 7)

2017-9-6 15:37 上传

点击文件名下载附件

您好 就是这个附件  谢谢啦

uynayna

1. Sub test()
   
2.     Dim d, arr, brr, wb As Workbook
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Set d1 = CreateObject("scripting.dictionary")
   
5.     arr = Sheet1.Range("a7:g" & Sheet1.[a65536].End(3).Row)
   
6.     t = ThisWorkbook.Path & "\数据库.xls"
   
7.     Set wb = Workbooks.Open(t)
   
8.     With wb.Worksheets(1)
   
9.         r = .Range("a65536").End(xlUp).Row
   
10.         brr = .Range("a2:f" & r)
    
11.         For i = 1 To UBound(brr)
    
12.            d(brr(i, 1)) = Array(brr(i, 2), brr(i, 3), brr(i, 4), brr(i, 5), brr(i, 6))
    
13.         Next
    
14.     End With
    
15.     ActiveWorkbook.Saved = True
    
16.     ActiveWorkbook.Close
    
17.     t = ThisWorkbook.Path & "\11.xls"
    
18.     Set wb = Workbooks.Open(t)
    
19.     With wb.Worksheets(1)
    
20.         r = .Range("a65536").End(xlUp).Row
    
21.         crr = .Range("a2:d" & r)
    
22.         For i = 1 To UBound(crr)
    
23.            d1(crr(i, 1)) = crr(i, 4)
    
24.         Next
    
25.     End With
    
26.     ActiveWorkbook.Saved = True
    
27.     ActiveWorkbook.Close
    
28.     For k = 1 To UBound(arr)
    
29.         arr(k, 2) = d(arr(k, 1))(0)
    
30.         arr(k, 3) = d(arr(k, 1))(1)
    
31.         arr(k, 4) = d(arr(k, 1))(2)
    
32.         arr(k, 5) = d(arr(k, 1))(3)
    
33.         arr(k, 6) = d(arr(k, 1))(4)
    
34.         arr(k, 7) = d1(arr(k, 1))
    
35.     Next
    
36.     Sheet1.[a7].Resize(UBound(arr), 7) = arr
    
37. End Sub
    

复制代码

11工作簿A列删除后。

ljpassport

uynayna 发表于 2017-9-6 16:18
11工作簿A列删除后。

提示类型错误啊

uynayna

你后传的文件，工作表没有数据。

ljpassport

uynayna 发表于 2017-9-6 16:44
你后传的文件，工作表没有数据。

嗯啊 对 就是那A列的数据从11工作薄里面的编码给弄过来