[已解决]宏制作

Bu過如此

请大神们看附件

最佳答案

月排行榜 / 总排行榜

七彩屋

2017-6-23 18:20

1. Sub 录入数据()
   
2. Application.ScreenUpdating = False
   
3. 
   
4. Dim Y
   
5. Y = Range("H4")
   
6. 
   
7.     x = 1
   
8.     Do While Not (IsEmpty(Sheets(Y).Cells(x, 2).Value))
   
9.         x = x + 1
   
10.     Loop
    
11. 
    
12.     n = x
    
13.     z = 5
    
14.     With Sheets("单据录入")
    
15.         Do While Not (IsEmpty(.Cells(z, 2).Value))
    
16.             z = z + 1
    
17.         Loop
    
18.         For k = 5 To z - 1
    
19.                 Sheets(Y).Cells(x, 1) = .Cells(2, 5)
    
20.                 Sheets(Y).Cells(x, 2) = .Cells(2, 3)
    
21.                 Sheets(Y).Cells(x, 3) = .Cells(k, 2)
    
22.                 Sheets(Y).Cells(x, 4) = .Cells(k, 3)
    
23.                 Sheets(Y).Cells(x, 5) = .Cells(k, 4)
    
24.                 Sheets(Y).Cells(x, 6) = .Cells(k, 5)
    
25.             x = x + 1
    
26.         Next k
    
27.     End With
    
28.     m = x - n
    
29.     MsgBox "您已向" & Y & "中加入了" & m & "条记录，请在" & Y & "中进行确认！"
    
30. Application.ScreenUpdating = True
    
31. End Sub

复制代码

跳转到最佳答案楼层

七彩屋

1. Sub 录入数据()
   
2. Application.ScreenUpdating = False
   
3. 
   
4. Dim Y
   
5. Y = Range("H4")
   
6. 
   
7.     x = 1
   
8.     Do While Not (IsEmpty(Sheets(Y).Cells(x, 2).Value))
   
9.         x = x + 1
   
10.     Loop
    
11. 
    
12.     n = x
    
13.     z = 5
    
14.     With Sheets("单据录入")
    
15.         Do While Not (IsEmpty(.Cells(z, 2).Value))
    
16.             z = z + 1
    
17.         Loop
    
18.         For k = 5 To z - 1
    
19.                 Sheets(Y).Cells(x, 1) = .Cells(2, 5)
    
20.                 Sheets(Y).Cells(x, 2) = .Cells(2, 3)
    
21.                 Sheets(Y).Cells(x, 3) = .Cells(k, 2)
    
22.                 Sheets(Y).Cells(x, 4) = .Cells(k, 3)
    
23.                 Sheets(Y).Cells(x, 5) = .Cells(k, 4)
    
24.                 Sheets(Y).Cells(x, 6) = .Cells(k, 5)
    
25.             x = x + 1
    
26.         Next k
    
27.     End With
    
28.     m = x - n
    
29.     MsgBox "您已向" & Y & "中加入了" & m & "条记录，请在" & Y & "中进行确认！"
    
30. Application.ScreenUpdating = True
    
31. End Sub

复制代码

七彩屋

原来的代码没细看，用上工作表变量就可以

Bu過如此

七彩屋 发表于 2017-6-23 18:21
原来的代码没细看，用上工作表变量就可以

谢谢您