ExcelVBA自动调整页面和生成银行盘

哆哆Excel

发布于 2022-10-31 15:41:43

5250

发布于 2022-10-31 15:41:43

文章被收录于专栏：哆哆Excel

【问题】

财务的同志们有这样的工作，他们在做好工资表后要做两件事

（1）整理美化页面，如行高、列宽、隐藏不打印行、等等

（2）复制数据户名、帐号、金额等，生成一个银行盘excel文件，到时要给银行工作人员用于发放。

以上工作如果是手工一步一步做可能要的时间30分钟左右，而且每月要做

【提出问题】：能不能快一点。

【回答】可以的

【代码】

''''''=====2022.08,作用是整理页面和生成银行盘==================
Sub yhd整理页面和生成银行盘()
    Dim DeclarationRow As Integer, SyLastRow As Integer, BwLastRow As Integer
    Dim wb As Workbooks, endRow As Integer, OutString As String
    Dim 序号 As Range, 帐号 As Range, 户名 As Range, 支付行号 As Range, 金额 As Range, 附言  As Range, 用户名 As Range
    Path = ThisWorkbook.Path
    t = Timer
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    With Sheets("工作表xxx")
        '====下面开始整理页面======
        .Select
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("B:B,E:F").ColumnWidth = 9
        .Range("C:C,L:L,N:O").ColumnWidth = 7
        .Range("D:D").ColumnWidth = 12
        .Range("A:A,G:K").ColumnWidth = 5
        endRow = .Range("a200000").End(xlUp).Row + 1
        Rows("2:" & endRow).RowHeight = 14.5
        .Rows("3:3").RowHeight = 16
        .Rows("4:4").RowHeight = 32
        '====下面复制数据生成工资盘======
        .Cells.EntireRow.Hidden = False
        endRow = .Range("A5").End(xlDown).Row
        Set 序号 = .Range("A5:A" & endRow)
        Set 帐号 = .Range("E5:E" & endRow)
        Set 户名 = .Range("C5:C" & endRow)
        Set 金额 = .Range("N5:N" & endRow)
        With Workbooks.Add
            With .Worksheets(1)
                .Cells.NumberFormatLocal = "@"
                .Range("A1:F1") = Array("序号", "帐号", "户名", "支付行号", "金额", "附言")
                序号.Copy
                .Range("A2").PasteSpecial Paste:=xlPasteValues
                帐号.Copy
                .Range("B2").PasteSpecial Paste:=xlPasteValues
                户名.Copy
                .Range("C2").PasteSpecial Paste:=xlPasteValues
                金额.Copy
                .Range("E2").PasteSpecial Paste:=xlPasteValues
                .Range("F2:F" & endRow - 3) = Format(Now, "mm月") & "工资"
                .UsedRange.Columns.AutoFit
                .Name = "他行"
            End With
            .SaveAs Path & "\" & Format(Now, "yyyy年mm月") & "工作表xxx-银行盘（农行）", xlWorkbookDefault
            .Close True
        End With
        OutString = OutString & .Name & "-" & Application.Max(序号) & "-" & Application.Sum(金额) & Chr(10)
    End With
    With Sheets("工作表yyy")
        '====下面开始整理页面======
        .Select
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("B:B,E:F").ColumnWidth = 9
        .Range("C:C,L:L,N:O").ColumnWidth = 7
        .Range("D:D").ColumnWidth = 12
        .Range("A:A,G:K").ColumnWidth = 5
        endRow = .Range("a20000").End(xlUp).Row + 1
        Rows("2:" & endRow).RowHeight = 14.5
        .Rows("3:3").RowHeight = 16
        .Rows("4:4").RowHeight = 32
        '====下面复制数据生成工资盘======
        .Cells.EntireRow.Hidden = False
        endRow = .Range("A5").End(xlDown).Row
        Set 序号 = .Range("A5:A" & endRow)
        Set 帐号 = .Range("E5:E" & endRow)
        Set 户名 = .Range("C5:C" & endRow)
        Set 金额 = .Range("N5:N" & endRow)
        With Workbooks.Add
            With .Worksheets(1)
                .Cells.NumberFormatLocal = "@"
                .Range("A1:F1") = Array("序号", "帐号", "户名", "支付行号", "金额", "附言")
                序号.Copy
                .Range("A2").PasteSpecial Paste:=xlPasteValues
                帐号.Copy
                .Range("B2").PasteSpecial Paste:=xlPasteValues
                户名.Copy
                .Range("C2").PasteSpecial Paste:=xlPasteValues
                金额.Copy
                .Range("E2").PasteSpecial Paste:=xlPasteValues
                .Range("F2:F" & endRow - 3) = Format(Now, "mm月") & "工资"
                .UsedRange.Columns.AutoFit
                .Name = "他行"
            End With
            .SaveAs Path & "\" & Format(Now, "yyyy年mm月") & "yy-银行盘（农行）", xlWorkbookDefault
            .Close True
        End With
        OutString = OutString & .Name & "-" & Application.Max(序号) & "-" & Application.Sum(金额) & Chr(10)
    End With
    With Sheets("www")
        .Select
        If .AutoFilterMode = True Then .AutoFilterMode = False
        .Range("A:A,J:Q").ColumnWidth = 4.5
        .Range("B:B,E:E").ColumnWidth = 9
        .Range("C:C,S:S,AA:AA").ColumnWidth = 7
        .Range("D:D").ColumnWidth = 12
        .Range("G:I,T:Y").ColumnWidth = 5
        endRow = .Range("a200000").End(xlUp).Row + 1
        Rows("2:" & endRow).RowHeight = 14.5
        .Rows("3:3").RowHeight = 16
        .Rows("4:4").RowHeight = 32
        '====下面复制数据生成工资盘======
        .Cells.EntireRow.Hidden = False
        endRow = .Range("A5").End(xlDown).Row
        Set 序号 = .Range("A5:A" & endRow)
        Set 帐号 = .Range("E5:E" & endRow)
        Set 户名 = .Range("C5:C" & endRow)
        Set 金额 = .Range("AA5:AA" & endRow)
        With Workbooks.Add
            With .Worksheets(1)
                .Cells.NumberFormatLocal = "@"
                .Range("A1:F1") = Array("序号", "帐号", "户名", "支付行号", "金额", "附言")
                序号.Copy
                .Range("A2").PasteSpecial Paste:=xlPasteValues
                帐号.Copy
                .Range("B2").PasteSpecial Paste:=xlPasteValues
                户名.Copy
                .Range("C2").PasteSpecial Paste:=xlPasteValues
                金额.Copy
                .Range("E2").PasteSpecial Paste:=xlPasteValues
                .Range("F2:F" & endRow - 3) = Format(Now, "mm月") & "工资"
                .UsedRange.Columns.AutoFit
                .Name = "他行"
            End With
            .SaveAs Path & "\" & Format(Now, "yyyy年mm月") & "www-银行盘（农行）", xlWorkbookDefault
            .Close True
        End With
        OutString = OutString & .Name & "-" & Application.Max(序号) & "-" & Application.Sum(金额) & Chr(10)
    End With
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    MsgBox "完成时间：" & Format(Timer - t, "00.00秒") & Chr(10) & OutString, vbOKOnly, "提示"
End Sub

【代码解析】