[已解决]如何分工序保存计件工资?

森林木007

老师又一个问题,请指导.
根据"产品代码"列第一位数据(1-5)判断为是否为第一工序至第五工序,然后追加数据到各个分表中.
计件工资分工序保存方法.zip (27.56 KB, 下载次数: 37)

2013-4-30 08:49 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

hwc2ycy

2013-4-30 09:40

1. Sub test()
   
2.     Dim arr
   
3.     Dim lLastRow&
   
4.     Dim str As String * 5, strSheetName$
   
5.     str = "一二三四五"
   
6.     With Worksheets("凭证信息录入")
   
7.         lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
   
8.         If lLastRow < 3 Then MsgBox "无有效数据": Exit Sub
   
9.         arr = .Range("b3:m" & lLastRow).Value
   
10.     End With
    
11.     Application.ScreenUpdating = False
    
12. 
    
13.     For i = LBound(arr) To UBound(arr)
    
14.         On Error Resume Next
    
15.         strSheetName = "第" & Mid(str, CInt(Left(arr(i, 5), 1)), 1) & "工序"
    
16.         'Debug.Print strSheetName, i
    
17.         If Err.Number = 0 Then
    
18.             With Worksheets(strSheetName)
    
19.                 .Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(, 12) = WorksheetFunction.Index(arr, i, 0)
    
20.             End With
    
21.         End If
    
22.         Err.Clear
    
23.     Next
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "数据整理完成", vbInformation
    
26. End Sub

复制代码

跳转到最佳答案楼层

hwc2ycy

1. Sub test()
   
2.     Dim arr
   
3.     Dim lLastRow&
   
4.     Dim str As String * 5, strSheetName$
   
5.     str = "一二三四五"
   
6.     With Worksheets("凭证信息录入")
   
7.         lLastRow = .Cells(Rows.Count, 2).End(xlUp).Row
   
8.         If lLastRow < 3 Then MsgBox "无有效数据": Exit Sub
   
9.         arr = .Range("b3:m" & lLastRow).Value
   
10.     End With
    
11.     Application.ScreenUpdating = False
    
12. 
    
13.     For i = LBound(arr) To UBound(arr)
    
14.         On Error Resume Next
    
15.         strSheetName = "第" & Mid(str, CInt(Left(arr(i, 5), 1)), 1) & "工序"
    
16.         'Debug.Print strSheetName, i
    
17.         If Err.Number = 0 Then
    
18.             With Worksheets(strSheetName)
    
19.                 .Cells(Rows.Count, 2).End(xlUp).Offset(1).Resize(, 12) = WorksheetFunction.Index(arr, i, 0)
    
20.             End With
    
21.         End If
    
22.         Err.Clear
    
23.     Next
    
24.     Application.ScreenUpdating = True
    
25.     MsgBox "数据整理完成", vbInformation
    
26. End Sub

复制代码

森林木007

hwc2ycy 发表于 2013-4-30 09:40

多谢大师出手!