有一张母表，需要把数据填到后面对应的sheet，求帮助！！！

shl7184894

求大家帮忙！！！

ykqrs

1. Sub qq()
   
2. Dim sht As Worksheet, arr, i%, j%, r%, s, n%, brr()
   
3. arr = Range("b1:e" & Cells(Rows.Count, 1).End(xlUp).Row)
   
4. For i = 2 To UBound(arr)
   
5. For Each sht In Sheets
   
6. n = 0
   
7. If sht.Name = arr(i, 1) Then
   
8. For j = 2 To 4
   
9. If arr(i, j) <> 0 Then
   
10. s = Split(arr(1, j), "-")
    
11. n = n + 1
    
12. ReDim Preserve brr(1 To 3, 1 To n)
    
13. brr(1, n) = s(1): brr(2, n) = s(0): brr(3, n) = arr(i, j)
    
14. End If
    
15. Next
    
16. sht.[a1].CurrentRegion.Offset(1).Clear
    
17. sht.[a2].Resize(n, 3) = Application.Transpose(brr)
    
18. Erase brr
    
19. Exit For
    
20. End If
    
21. Next
    
22. Next
    
23. End Sub

复制代码

ykqrs

求助.rar (19.76 KB, 下载次数: 3)

2018-9-1 10:28 上传

点击文件名下载附件

shl7184894

朱荣兴 发表于 2018-9-1 10:12
Sub 数据分配()
Set d = CreateObject("scripting.dictionary")
For Each sh In Sheets

我用测试的文件可以实现效果，用需要转化的实际表格时候，提示下标越界，请问下这个怎么处理？

shl7184894

shl7184894 发表于 2018-9-1 10:39
我用测试的文件可以实现效果，用需要转化的实际表格时候，提示下标越界，请问下这个怎么处理？

找到问题了。。