首次独立使用Excel VBA解决问题

2015年10月19日14:06:17 发表评论 0

之前就知道VBA很强大,恰巧最近有曾经的同事拿来一个日报表求助做汇总表。首先想到的是函数解决,但貌似很麻烦,于是决定使用VBA来做。

主要就是根据每日入离职报表生成月报表,源文件是每天一个SHEET,一个月20多个SHEET,解决的思路是先将当月所以日报表汇总到一起,然后在计算汇总数。

源码如下:

Attribute VB_Name = "模块5"
Sub 生成汇总表()
 Sheets.Add
    ActiveSheet.Name = "过程表"     '创建过程表
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "XX集团人员流动汇总表"       '制作表头
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "序号"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "城市"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "营业部"
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "入职人数"
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "管理层"
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "职能类"
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "销售团队"
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "合计"
    Range("D3:G3").Select
    Selection.Copy
    Range("H3").Select
    ActiveSheet.Paste
    Range("L3").Select
    ActiveSheet.Paste
    Range("H2").Select
    Application.CutCopyMode = False
    ActiveCell.FormulaR1C1 = "离职人数"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "总人数"
    Range("P2").Select
    ActiveCell.FormulaR1C1 = "备注"
    Range("A2:A3,B2:B3,C2:C3,D2:G2,H2:K2,L2:O2,P2:P3,A1:P1").Select
    Range("P1").Activate
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("A1:P3").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1:P1").Select
    Selection.Font.Bold = True
'将各sheet数据合并
Rows("4:65536").Clear   '删除所有记录
Dim sht As Worksheet, xrow As Integer, rng As Range
For Each sht In Worksheets   '遍历工作表
    If sht.Name <> ActiveSheet.Name Then
       Set rng = Range("a65536").End(xlUp).Offset(1, 0) '获得A列第一个空单元格
       xrow = sht.Range("a1").CurrentRegion.Rows.Count - 3  ' 获得分表中的记录条数
       sht.Range("a4").Resize(xrow, 16).Copy rng  '复制记录到汇总表
    End If
Next
Sheets.Add                         '新建“月汇总表”sheet
    ActiveSheet.Name = "月汇总表"      '新建“月汇总表”sheet
    Sheets("过程表").Select            '复制过程表表头
    Range("A1:P3").Select
    Selection.Copy
    Sheets("月汇总表").Select          '将过程表表头粘贴至“月汇总表”
    Range("A1").Select
    ActiveSheet.Paste
    Sheets("过程表").Select            '复制过程表内容
    Range("a6:c65536").Select
    Selection.Copy
    Sheets("月汇总表").Select          '将过程表内容粘贴至“月汇总表”
    Range("A4").Select
    ActiveSheet.Paste
    '删除合计()
    Range("A4:C819").Select
    Selection.ClearFormats
    ActiveWindow.SmallScroll Down:=18
    Range("E33").Select
    ActiveWindow.SmallScroll Down:=-36
    Range("C4:C816").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.EntireRow.Delete
    Range("C4:C65536").Select
    ActiveSheet.Range("$C$4:$C$65536").RemoveDuplicates Columns:=1, Header:=xlNo
    ActiveWindow.ScrollRow = 1
    Range("A:A,B:B").Delete
    Range("B4:M65536").Select
    ActiveCell.FormulaR1C1 = _
        "=IF(COUNTA(RC1)=1,SUMIF(过程表!C3,月汇总表!RC1,过程表!C[2]),"""")"     '写入公式
    Range("B4").Select
    Selection.AutoFill Destination:=Range("B4:M4"), Type:=xlFillDefault     '公式填充
    Range("B4:M4").Select
    Selection.AutoFill Destination:=Range("B4:M65536"), Type:=xlFillDefault
    Range("B2:E2").Select
    ActiveCell.FormulaR1C1 = "当月入职人数"     '修改表头
    Range("F2:I2").Select
    ActiveCell.FormulaR1C1 = "当月离职人数"
    Range("J2:M2").Select
    ActiveCell.FormulaR1C1 = "当月总人数"
    Range("B3").Select
    Cells.Select        '复制内容并粘贴为数值(以去掉公式)
    Range("D7").Activate
    Selection.Copy
    Range("A1:N1").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Sheets("过程表").Select     '删除过程表
    ActiveWindow.SelectedSheets.Delete
End Sub

放在这里做为备忘,以后遇到同样的问题再回来复习。

发表评论

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen: