[已解决]求助VBA代码完成，拜谢

ry_cw01

目的：
1、“计划汇总工作表”中每笔业务自动生成“计划明细表”

要求：

1、根据计划汇总表中每笔业务的产品代码自动在此工作簿中查找到以此代码为工作表名的工作表

2、对找到的工作表中的A2:E“N”区域进行复制到“计划明细”工作表中的C：G

3、对粘贴到“计划工作表”中的此笔业务添加“计划汇总表”中针对于此笔业务的“日期”于A列、“单据编号”于B列、“生产件数”于I列、生产量于J列

4、在H列输入公式=IF(MID(E2,1,7)="001.03.",I2*G2,ROUND(J2/1000*G2,2))

5、对每笔业务单据编号的第一个单元格着色

注意：前提计划汇总表中的业务笔数不固定，

最佳答案

月排行榜 / 总排行榜

dsmch

2014-4-22 18:12

………………

跳转到最佳答案楼层

dsmch

1. Sub Macro2()
   
2. Dim arr, brr, crr, i&, x&
   
3. arr = Sheet1.Range("a1").CurrentRegion
   
4. [a2:h20000].Clear
   
5. For i = 2 To UBound(arr)
   
6.     If Not Sheets(arr(i, 3)) Is Nothing Then
   
7.         brr = Sheets(arr(i, 3)).Range("a1").CurrentRegion
   
8.         ReDim crr(1 To UBound(brr) - 1, 1 To 2)
   
9.         For j = 2 To UBound(brr)
   
10.             crr(j - 1, 1) = arr(i, 2)
    
11.             crr(j - 1, 2) = arr(i, 1)
    
12.         Next
    
13.         x = Cells(Rows.Count, 1).End(xlUp).Row + 1
    
14.         Cells(x, 2).Interior.ColorIndex = 6
    
15.         Cells(x, 1).Resize(UBound(crr), 2) = crr
    
16.         Sheets(arr(i, 3)).Range("a1").CurrentRegion.Offset(1, 0).Copy Cells(x, 3)
    
17.     End If
    
18. Next
    
19. [h2] = "=IF(MID(E2,1,7)=""001.03."",I2*G2,ROUND(J2/1000*G2,2))"
    
20. [h2:h20000].FillDown
    
21. End Sub
    

复制代码

dsmch

………………

ry_cw01

dsmch 发表于 2014-4-22 14:09
………………

对粘贴到“计划工作表”中的此笔业务添加“计划汇总表”中针对于此笔业务的“生产件数”于I列、生产量于J列，还差一点点，拜托前辈调整下，不胜感激

su45

应该是这样的吧！(没上面几位动作快)

dsmch

………………