关于工作簿数据导入

wcl24202

貌似之前的帖子沉了，麻烦各位大神老师给出代码指导一下：
系统分表导入数据到总表
比如总表中第一栏:
实际人数        正式工
                实习
                 外派
                本地
               外包
              总人数

在分表中也有一模一样的第一栏，带着数据的
实际人数        正式工 60
                  实习 3
                   外派 5
                  本地 0
                 外包 0
                总人数
然后把分表的数据直接导入总表即可，位置基本是对等的， 除了总表有高亮成黄色的一段无需导入数据 而从黄色以后的部分又需要导入数据了，当中跳开了几行。
谢谢老师们！！！

看见星光

1. Sub DoDict()
   
2.     Dim d As Object, ws As Object
   
3.     Dim arr, i As Long, j As Long, s As String, n As Long
   
4.     Set d = CreateObject("scripting.dictionary")
   
5.     With GetObject(ThisWorkbook.Path & "/系统131.xls")
   
6.         arr = .Sheets(1).UsedRange
   
7.         .Close False
   
8.     End With
   
9.     For i = UBound(arr) - 1 To 1 Step -1
   
10.         If arr(i, 1) = "" Then arr(i, 1) = arr(i + 1, 1)
    
11.     Next
    
12.     For i = 1 To UBound(arr)
    
13.         If arr(i, 3) <> "" And arr(i, 2) = "" Then n = i
    
14.         If n Then
    
15.             For j = 3 To UBound(arr, 2)
    
16.                 s = arr(i, 1) & "," & arr(i, 2) & "," & arr(n, j)
    
17.                 d(s) = arr(i, j)
    
18.             Next
    
19.         End If
    
20.     Next
    
21.     arr = [a1].CurrentRegion
    
22.     For i = 2 To UBound(arr)
    
23.         If arr(i, 2) = "" Then arr(i, 2) = arr(i - 1, 2)
    
24.         For j = 4 To 7
    
25.             s = arr(i, 2) & "," & arr(i, 3) & "," & arr(1, j)
    
26.             If d.exists(s) Then arr(i, j) = d(s)
    
27.         Next
    
28.     Next
    
29.     [a1].CurrentRegion = arr
    
30.     Set d = Nothing
    
31. End Sub

复制代码

看见星光

求助.rar (46.28 KB, 下载次数: 8)

2018-6-21 21:28 上传

点击文件名下载附件

wcl24202

看见星光 发表于 2018-6-21 21:28

谢谢大神老师！！ 膜拜

不知道为什么

wcl24202 发表于 2018-6-21 21:49
谢谢大神老师！！ 膜拜

膜拜大神的最好途径就是送上评分和鲜花啊，呵呵

wcl24202

不知道为什么 发表于 2018-6-21 21:54
膜拜大神的最好途径就是送上评分和鲜花啊，呵呵

感谢提醒，已经操作了，呵呵