[已解决]将对应的1到4列数据加载到目标表中

maysh2009

大家好，最近遇到一个问题，将对应的1到4列数据加载到目标表中，根据2列数据（唯一），

将对应的1到4列数据（可变），添加到后面，附件附了几十条数据，谢谢大侠们！

小区加载.rar (184.11 KB, 下载次数: 16)

2012-10-9 13:14 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

suye1010

2012-10-9 14:22

1. Option Explicit
   
2. 
   
3. Sub Sta()
   
4. Dim i%, j%, k%, arr0, arr, d, TempArr
   
5.     arr0 = Workbooks("统计.xlsx").Sheets(1).UsedRange
   
6.     arr = Sheets(1).Range("A1").CurrentRegion
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8. For i = 1 To UBound(arr0)
   
9.     d.Add arr0(i, 3) & arr0(i, 1), Split(arr0(i, 4), ",")
   
10. Next i
    
11. For j = 1 To UBound(arr)
    
12.     If d.exists(arr(j, 1) & arr(j, 3)) Then
    
13.         TempArr = d(arr(j, 1) & arr(j, 3))
    
14.         For k = 0 To UBound(TempArr)
    
15.             arr(j, 10 + k * 2) = TempArr(k)
    
16.         Next k
    
17.     End If
    
18. Next j
    
19. Sheets(1).Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
20. End Sub
    

复制代码

跳转到最佳答案楼层

suye1010

1. Option Explicit
   
2. 
   
3. Sub Sta()
   
4. Dim i%, j%, k%, arr0, arr, d, TempArr
   
5.     arr0 = Workbooks("统计.xlsx").Sheets(1).UsedRange
   
6.     arr = Sheets(1).Range("A1").CurrentRegion
   
7.     Set d = CreateObject("Scripting.Dictionary")
   
8. For i = 1 To UBound(arr0)
   
9.     d.Add arr0(i, 3) & arr0(i, 1), Split(arr0(i, 4), ",")
   
10. Next i
    
11. For j = 1 To UBound(arr)
    
12.     If d.exists(arr(j, 1) & arr(j, 3)) Then
    
13.         TempArr = d(arr(j, 1) & arr(j, 3))
    
14.         For k = 0 To UBound(TempArr)
    
15.             arr(j, 10 + k * 2) = TempArr(k)
    
16.         Next k
    
17.     End If
    
18. Next j
    
19. Sheets(1).Cells(1, 1).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    
20. End Sub
    

复制代码

maysh2009

suye1010 发表于 2012-10-9 14:22

谢谢斑竹的热心帮忙