【VBA研究】将库存总表按供应商拆分成分表

作者：iamlaosong

 

我们可以从系统中导出库存总表，需要将总表中的数据按供应商分解到相应的表中，开始用手工做，需要2个多小时，采用下面的宏，只要十几秒就解决了。

 

Sub chaifen()
'
' chaifen Macro
' 宏由 iamlaosong 编制，时间: 2010-12-17
'

'
Nvendor = 45
num = 1
Sheets(2).Select
Cells(1, 4) = Time()
Range("c1:c45").Select                '删除原有标志
Selection.ClearContents

Do While num <= Nvendor
   
    Vendor = Cells(num, 1)
    Fname = Cells(num, 2)
    Sheets(1).Select
    FullName = ThisWorkbook.Path & "/kucun/" & Fname
    'MsgBox FullName
    Workbooks.Open Filename:=FullName
    Cells(3, 5) = "2010-12-17"
    Cells(4, 2) = "PD07"
    If (Vendor <> Cells(5, 2)) Then MsgBox "供应商编码不符!"
  
    Range("A9:G500").Select                '删除原有数据
    Selection.ClearContents
    Range("A9").Select
    Cells(9, 1) = "1"
   
    Windows("库存数.xls").Activate
    Selection.AutoFilter Field:=2, Criteria1:=Vendor
    MaxRow = [a65536].End(xlUp).Row               '返回筛选结果最后一行行号
    'MsgBox MaxRow
   
    RowC = Application.WorksheetFunction.Subtotal(3, Range("a1:a2000"))   '筛选结果的行数,其中Range("c1:c2000")因表长度而异
    'MsgBox RowC
    MinRow = 2             '因为不连续只能从第二行开始，如果连续可以计算最小行MaxRow - RowC + 1（不包括标题行）
    'MsgBox MinRow
    Range("c" & MinRow & ": d" & MaxRow).Select   '选定零部件区域
    Selection.Copy                                '复制区域
    'MsgBox "c" & MinRow & ": d" & MaxRow

    Windows(Fname).Activate
    Range("B9").Select
    ActiveSheet.Paste
   
    Windows("库存数.xls").Activate
    Range("g" & MinRow & ": g" & MaxRow).Select   '选定库存数量区域
    Selection.Copy                                '复制区域
    Windows(Fname).Activate
    Range("F9").Select
    ActiveSheet.Paste
   
    If RowC > 2 Then
        Range("A9").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("A9:A" & (RowC + 7)), Type:=xlFillSeries '填写编号
        Range("A9:A" & (RowC + 7)).Select
        Range("H9").Select
        Application.CutCopyMode = False
        Selection.AutoFill Destination:=Range("H9:H" & (RowC + 7)), Type:=xlFillCopy  '填写库位
        Range("H9:H" & (RowC + 7)).Select
    End If
    
     'n = [F65536].End(xlUp).Row + 1 '找出F列最后一个单元格的位置

    Cells(RowC + 8, 6) = "=SUM(F9:F" & RowC + 7 & ")"        '对F求和,并写入F列最后一个单元格
    sum1 = Cells(RowC + 8, 6)                  '把数值保存到变量
   
    ActiveWorkbook.Save
    ActiveWindow.Close
   
    Windows("库存数.xls").Activate
    Sheets(2).Select
    Cells(num, 3) = sum1
    num = num + 1
   
Loop
Cells(1, 5) = Time()
Cells(Nvendor + 1, 3) = "=SUM(C1:C" & Nvendor & ")"

End Sub