运用VBA跨工作簿填充相应数据

nana771590423

求各位大神帮帮忙！小妹在此先感谢你们！求VBA代码,能一键完成下面的需求：有一个"tool.csv "为原数据，根据checklist把“current value"和”result"数据填到"checkbook.XLS"相应的项中。想要的效果的也放在里面了。谢谢谢谢！！！！感激不尽！！！

1，tool.csv



2，最终填进checkbook里的效果图。根据checklist 把对应的“current value"和”result"数据填到里面去。



3,注意的点是:(1)checkist 列里面包含多个checklist,要把符合要求的都以分行格填在同一个单元格里。
                      (2)checklist 可能对应多行的current value,要以分行格全填在同一单元格了。
book.zip (25.93 KB, 下载次数: 7)

2018-7-3 17:30 上传

点击文件名下载附件

nana771590423

请老师们帮帮忙，跪谢！

yaojil

这样试试吧

nana771590423

yaojil 发表于 2018-7-4 20:28
这样试试吧

谢谢您的帮忙，但是我按了按钮后，在这一栏里据出现了错误，求解！谢谢！

yaojil

不知为何你的代码打开汉字是乱码
换个不同操作系统的计算机试试呢

1. Sub check()
   
2. 'http://club.excelhome.net/thread-1422774-1-3.html
   
3. Application.ScreenUpdating = flase
   
4. Dim arr, d1, d2
   
5. Set d1 = CreateObject("scripting.dictionary")
   
6. Set d2 = CreateObject("scripting.dictionary")
   
7. With GetObject(ThisWorkbook.Path & "\tool.csv")
   
8.    arr = .Sheets("tool").UsedRange
   
9.    .Close False
   
10. End With
    
11. For i = 2 To UBound(arr)
    
12.    If Not d1.exists(arr(i, 5)) Then
    
13.       d1(arr(i, 5)) = arr(i, 9)
    
14.    Else
    
15.       d1(arr(i, 5)) = d1(arr(i, 5)) & Chr(10) & arr(i, 9)
    
16.    End If
    
17.       If Not d2.exists(arr(i, 5)) Then
    
18.       d2(arr(i, 5)) = arr(i, 10)
    
19.    Else
    
20.       d2(arr(i, 5)) = d2(arr(i, 5)) & Chr(10) & arr(i, 10)
    
21.    End If
    
22. Next
    
23. arr = Sheets("检查表").Range("j2:n" & Sheets("检查表").[n65536].End(3).Row)
    
24. For i = 1 To UBound(arr)
    
25.    If InStr(arr(i, 5), Chr(10)) Then
    
26.       tmp = Split(arr(i, 5), Chr(10))
    
27.       For j = 0 To UBound(tmp)
    
28.          If d1.exists(tmp(j)) Then
    
29.             If arr(i, 1) = "" Then
    
30.                arr(i, 1) = d1(tmp(j))
    
31.             Else
    
32.                arr(i, 1) = arr(i, 1) & Chr(10) & d1(tmp(j))
    
33.             End If
    
34.          End If
    
35.          If d2.exists(tmp(j)) Then
    
36.             If arr(i, 2) = "" Then
    
37.                arr(i, 2) = d2(tmp(j))
    
38.             Else
    
39.                arr(i, 2) = arr(i, 2) & Chr(10) & d2(tmp(j))
    
40.             End If
    
41.          End If
    
42.       Next
    
43.    Else
    
44.       If d1.exists(arr(i, 5)) Then
    
45.             If arr(i, 1) = "" Then
    
46.                arr(i, 1) = d1(arr(i, 5))
    
47.             Else
    
48.                arr(i, 1) = arr(i, 1) & Chr(10) & d1(arr(i, 5))
    
49.             End If
    
50.          End If
    
51.          If d2.exists(arr(i, 5)) Then
    
52.             If arr(i, 2) = "" Then
    
53.                arr(i, 2) = d2(arr(i, 5))
    
54.             Else
    
55.                arr(i, 2) = arr(i, 2) & Chr(10) & d2(arr(i, 5))
    
56.             End If
    
57.          End If
    
58.    End If
    
59. Next
    
60. 
    
61. Sheets("检查表").Range("j2").Resize(UBound(arr), UBound(arr, 2)) = arr
    
62. Application.ScreenUpdating = True
    
63. End Sub
    

复制代码

nana771590423

yaojil 发表于 2018-7-5 11:29
不知为何你的代码打开汉字是乱码
换个不同操作系统的计算机试试呢

我把中文改成英文，可以运行，刚试了一下好像没有问题了！我激动啊！这省了好多力气啊！谢谢谢谢！！！！

nana771590423

yaojil 发表于 2018-7-5 11:29
不知为何你的代码打开汉字是乱码
换个不同操作系统的计算机试试呢

大师，请问如果我想用包含“Report”这个字眼的文件，比如"123Report.csv"，这个 With GetObject(ThisWorkbook.Path & "\tool.csv")应该怎样修改呢