请大侠帮忙，关于出库单自动汇总出库汇总表的Active控件的VB命令

杨润宇

如附件内表格，本表格是一个“出库单”自动汇总到“出库明细表”的表格，通过表“出库单”的Active控件的VB命令来运作。但是此表只能自动汇总出库单第一行的数据，第二行第三行就不行了，打个比方：本次出库了A、B、C三种商品，分别位于表“出库单”的第七行、第八行、第九行，点击Active控件“出库”后汇总，结果只有A商品被汇总进了“出库明细表”，B、C两种产品都没被汇总。求大侠帮忙改进VB语句，能够完整的把产品汇总进“出库明细表”，谢谢！

zzwzengdavid

1. Private Sub Clrbtn_Click()
   
2.    Range("B3:D3,F3:H3,B4:D4,F4:H4,B5:D5,F5:H5,A7:G13,E16:F16").ClearContents
   
3.    ActiveSheet.Cells(3, 2).Activate
   
4. End Sub
   
5. 
   
6. Private Sub Rukubtn_Click()
   
7.     Dim RowNum As Integer
   
8.     Dim RowNum1 As Integer
   
9.     Dim Count As Integer
   
10.   
    
11.     Application.ScreenUpdating = False
    
12.     If Sheets("出库单").Cells(3, 2) <> "" And Sheets("出库单").Cells(14, 6) <> 0 Then
    
13.          RowNum1 = Application.WorksheetFunction.CountA(Range("A7:A13")) + 6
    
14.          With Sheets("出库明细表")
    
15.          For Count = 7 To RowNum1
    
16.                 If Not IsEmpty(Sheets("出库单").Cells(Count, 1)) Then
    
17.                 RowNum = Sheets("出库明细表").[D65536].End(xlUp).Row + 1
    
18.               .Cells(RowNum, 1) = Sheets("出库单").Cells(3, 2)      '出库单号
    
19.               .Cells(RowNum, 2) = Sheets("出库单").Cells(3, 6)      '出库日期
    
20.               .Cells(RowNum, 3) = Sheets("出库单").Cells(4, 2)      '购货单位
    
21.               .Cells(RowNum, 12) = Sheets("出库单").Cells(14, 6)    '合计金额
    
22.               .Cells(RowNum, 13) = Sheets("出库单").Cells(16, 5)    '已付金额
    
23.               .Cells(RowNum, 14) = Sheets("出库单").Cells(16, 2)    '应付金额
    
24.               .Cells(RowNum, 15) = Sheets("出库单").Cells(4, 6)     '业务员
    
25.                    .Cells(RowNum, 4) = Sheets("出库单").Cells(Count, 1) '商品编码
    
26.                    .Cells(RowNum, 5) = Sheets("出库单").Cells(Count, 2) '商品名称
    
27.                    .Cells(RowNum, 6) = Sheets("出库单").Cells(Count, 3) '规格型号
    
28.                    .Cells(RowNum, 7) = Sheets("出库单").Cells(Count, 4)    '类别
    
29.                    .Cells(RowNum, 8) = Sheets("出库单").Cells(Count, 5)     '单位
    
30.                    .Cells(RowNum, 9) = Sheets("出库单").Cells(Count, 6)    '单价
    
31.                    .Cells(RowNum, 10) = Sheets("出库单").Cells(Count, 7)     '数量
    
32.                    .Cells(RowNum, 11) = Sheets("出库单").Cells(Count, 8)   '金额
    
33.                    '更新库存量
    
34.                 End If
    
35.                    Next Count
    
36.                On Error Resume Next
    
37.               .Range(.Cells(1, -1), .Cells(RowNum - 1, 14)).Borders.LineStyle = xlContinuous
    
38.          End With
    
39.              Clrbtn_Click
    
40.          If ret = vbOK Then
    
41.               ActiveSheet.Cells(3, 2).Activate
    
42.          Else
    
43.               Range("B3:D3,F3:H3,B4:D4,F4:H4,B5:D5,F5:H5,A7:G13,E16:F16").ClearContents
    
44.          End If
    
45.     End If
    
46.     Application.ScreenUpdating = True
    
47. End Sub

复制代码

zzwzengdavid

请看附件是否符合要求

杨润宇

zzwzengdavid 发表于 2012-11-18 09:01
请看附件是否符合要求

已实现功能！非常感谢！

ying930

学习，收藏

雄心壮志

刚好要弄这个，学习一下，谢谢！

徐远伟

学习一下非常感谢！