[已解决]求高手帮忙做一个VBA，具体要求见附件统计表中说明

清秋淡水

求高手帮忙做一个VBA，要求《统计表》中的自动从《报表》中取相应的数据，相关样板及要求在《统计表》中有说明，如有看不明白的，还请提出，这是工作是遇到的难题，烦请高手帮忙解决，非常感谢

最佳答案

月排行榜 / 总排行榜

grf1973

2015-12-23 13:15

请看附件。

跳转到最佳答案楼层

grf1973

请看附件。

QCW911

顶

grf1973

由于报表文件比较大，打开费时，所以先打开报表文件后，再点击按钮。

1. Sub 读取()        '在报表文件打开的前提下运行
   
2.     Dim wb As Workbook, sh As Worksheet
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     brr = Sheets(2).[a1].CurrentRegion
   
5.     For i = 3 To UBound(brr)      '不良原因和代码相对应
   
6.         d(brr(i, 1)) = brr(i, 2)
   
7.     Next
   
8.     'Set wb = Workbooks.Open(ThisWorkbook.Path & "\报表.xls")
   
9.     Set wb = Workbooks("报表.xls")
   
10.     Set sh = wb.Worksheets(1)
    
11.     arr = sh.Range("a1:db" & sh.[b65536].End(3).Row)
    
12.     With ThisWorkbook.Sheets(1)
    
13.         For i = 3 To UBound(arr)
    
14.             If arr(i, 8) <> "" Then   'H列非空
    
15.                 x = arr(i, 44) '不良分类AR列
    
16.                 Do While Len(x) > 0
    
17.                     For k = 1 To Len(x)
    
18.                         If IsNumeric(Mid(x, k, 1)) Then Exit For
    
19.                     Next
    
20.                     bl = Left(x, k - 1): sl = Val(Mid(x, k))      '不良及数量
    
21.                     r = .[b65536].End(3).Row + 1
    
22.                     .Cells(r, "B") = arr(i, 5) '订单号
    
23.                     .Cells(r, "D") = arr(i, 2) '工作中心（铜牌号）
    
24.                     If arr(i, 105) > 0 Then .Cells(r, "M") = arr(i, 105) '作业时间1（合计工时DA列）
    
25.                     If arr(i, 61) > 0 Then .Cells(r, "P") = arr(i, 61) '作业时间2（合计工时BI列）
    
26.                     If arr(i, 68) > 0 Then .Cells(r, "S") = arr(i, 68) '作业时间3（合计工时BP列）
    
27.                     .Cells(r, "AD") = arr(i, 106) '确认内文（工时分布）
    
28.                     .Cells(r, "J") = sl '不良数量
    
29.                     If d.exists(bl) Then .Cells(r, "K") = d(bl) Else .Cells(r, "K") = bl '不良原因（或代码）
    
30.                     x = Replace(x, bl & sl, "")
    
31.                 Loop
    
32.             End If
    
33.         Next
    
34.     End With
    
35. End Sub
    

复制代码

清秋淡水

grf1973 发表于 2015-12-22 10:25
由于报表文件比较大，打开费时，所以先打开报表文件后，再点击按钮。

高手，太感谢了，你好厉害哦。

清秋淡水

清秋淡水 发表于 2015-12-22 19:57
高手，太感谢了，你好厉害哦。

师傅，可能是我之前没写清楚要求，我重新补充了取值说明，还请师傅帮忙再改一下，再次感谢。

清秋淡水

grf1973 发表于 2015-12-22 10:25
由于报表文件比较大，打开费时，所以先打开报表文件后，再点击按钮。

师傅，可能是我之前没写清楚要求，我重新补充了取值说明，还请师傅帮忙再改一下，再次感谢。

清秋淡水

grf1973 发表于 2015-12-23 13:15
请看附件。

谢谢，

清秋淡水

grf1973 发表于 2015-12-23 13:15
请看附件。

师傅：早上好，我这有一张统计表跟此贴的统计表有些类似，帮我看一下能否帮忙制作VBA，谢谢啦

http://www.excelpx.com/thread-375947-1-1.html