[已解决]如何用VBA，将总表里的内容按日期，分别在对应的表里出来

新一

如何用VBA，将总表里的内容按日期，分别在对应的表里出来。附件有两个工作薄，一个是冲、铹，要求，按照其工种为冲压和铹铣工，才能够输入分表中，而工种为锻压的不录入表中。第二个表为“锻”，要求工种为锻压的，才能够输入分表中，而工种为冲压和铹铣工的不录入表中。可否解决，谢谢。

最佳答案

月排行榜 / 总排行榜

dsmch

2014-3-23 10:55

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%, y&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("总表").Activate
   
5. arr = Range("a2").CurrentRegion
   
6. ReDim brr(1 To UBound(arr), 1 To 10)
   
7. y = UBound(arr, 2)
   
8. For j = 5 To Sheets.Count
   
9.     Sheets(j).UsedRange.Offset(2, 0).ClearContents
   
10. Next
    
11. For i = 3 To UBound(arr)
    
12.     If arr(i, 9) = "冲压" Or arr(i, 9) = "铹铣" Then d(arr(i, 1)) = d(arr(i, 1)) & " " & i
    
13. Next
    
14. a = d.keys: b = d.items
    
15. For i = 0 To d.Count - 1
    
16.     x = Split(b(i))
    
17.     z = Day(a(i))
    
18.     For j = 1 To UBound(x)
    
19.         brr(j, 1) = a(i)
    
20.         brr(j, 2) = arr(x(j), 3)
    
21.         brr(j, 3) = arr(x(j), 4)
    
22.         brr(j, 4) = arr(x(j), 5)
    
23.         brr(j, 5) = arr(x(j), 6)
    
24.         brr(j, 6) = arr(x(j), 7)
    
25.         brr(j, 8) = arr(x(j), 8)
    
26.         brr(j, 9) = arr(x(j), 9)
    
27.     Next
    
28.     Sheets("" & z).Cells(3, 1).Resize(UBound(x), UBound(brr, 2)) = brr
    
29. Next
    
30. End Sub
    

复制代码

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr, d, i&, j%, y&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("总表").Activate
   
5. arr = Range("a2").CurrentRegion
   
6. y = UBound(arr, 2)
   
7. For i = 3 To UBound(arr)
   
8.     If arr(i, 9) = "冲压" Or arr(i, 9) = "铹洗" Then d(arr(i, 1)) = d(arr(i, 1)) & " " & i
   
9. Next
   
10. a = d.keys: b = d.items
    
11. For i = 0 To d.Count - 1
    
12.     x = Split(b(i))
    
13.     z = Day(a(i))
    
14.     For j = 1 To UBound(x)
    
15.         Cells(x(j), 1).Resize(1, y).Copy Sheets("" & z).Cells(j + 2, 1)
    
16.     Next
    
17. Next
    
18. End Sub
    

复制代码

dsmch

两个类似，另一个自己试着做一下

新一

dsmch 发表于 2014-3-23 10:32

可否上传一下附件，谢谢，共两个表。

新一

dsmch 发表于 2014-3-23 10:37
两个类似，另一个自己试着做一下

名称这一栏，对不上。

新一

新一 发表于 2014-3-23 10:40
名称这一栏，对不上。

为什么只显视冲压，铹铣工没有显视？

dsmch

1. Sub Macro1()
   
2. Dim arr, brr, d, i&, j%, y&
   
3. Set d = CreateObject("scripting.dictionary")
   
4. Sheets("总表").Activate
   
5. arr = Range("a2").CurrentRegion
   
6. ReDim brr(1 To UBound(arr), 1 To 10)
   
7. y = UBound(arr, 2)
   
8. For j = 5 To Sheets.Count
   
9.     Sheets(j).UsedRange.Offset(2, 0).ClearContents
   
10. Next
    
11. For i = 3 To UBound(arr)
    
12.     If arr(i, 9) = "冲压" Or arr(i, 9) = "铹铣" Then d(arr(i, 1)) = d(arr(i, 1)) & " " & i
    
13. Next
    
14. a = d.keys: b = d.items
    
15. For i = 0 To d.Count - 1
    
16.     x = Split(b(i))
    
17.     z = Day(a(i))
    
18.     For j = 1 To UBound(x)
    
19.         brr(j, 1) = a(i)
    
20.         brr(j, 2) = arr(x(j), 3)
    
21.         brr(j, 3) = arr(x(j), 4)
    
22.         brr(j, 4) = arr(x(j), 5)
    
23.         brr(j, 5) = arr(x(j), 6)
    
24.         brr(j, 6) = arr(x(j), 7)
    
25.         brr(j, 8) = arr(x(j), 8)
    
26.         brr(j, 9) = arr(x(j), 9)
    
27.     Next
    
28.     Sheets("" & z).Cells(3, 1).Resize(UBound(x), UBound(brr, 2)) = brr
    
29. Next
    
30. End Sub
    

复制代码

新一

dsmch 发表于 2014-3-23 10:55

为什么只显视冲压工，没有铹铣工？

dsmch

新一 发表于 2014-3-23 10:59
为什么只显视冲压工，没有铹铣工？

代码中

铹铣打错了

新一

dsmch 发表于 2014-3-23 11:17
代码中

我的第二个表的格式，和冲、铹，的格式有点不同，不明白如何修改，才能达到效果。可否帮帮忙。