Question

我目前有一个格式化excel文件的宏。我很好奇是否有办法让这种格式包含标题中包含特定文本的所有工作表。我会为各公司提供一个包含大量标签的工作簿，每个公司的格式要求略有不同，有些月份会有一些公司不同。如果床单不存在，那么忽略并继续......任何帮助将不胜感激。

Worksheets("DEN BS Assets").Select

Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long



With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With


Cells.Select
Cells.EntireColumn.AutoFit
Columns("A:A").Select
Selection.ColumnWidth = 12


Columns("A:A").Select
Selection.Replace What:="X", Replacement:="", LookAt:=xlPart, _
    SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
    ReplaceFormat:=False





With ActiveSheet
.Select

    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    .DisplayPageBreaks = False


    Firstrow = 9
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "A")

            If Not IsError(.Value) Then

                Select Case .Value
                Case Is = "Denver", "Inactive", "System:": .EntireRow.Delete
                End Select


            End If


        End With

    Next Lrow

End With



With ActiveSheet
.Select

    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    .DisplayPageBreaks = False


    Firstrow = 7
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "A")

            If Not IsError(.Value) Then

                Select Case .Value
                Case Is = "Net Change", "Account:": .EntireRow.Insert
                End Select

            End If


        End With

    Next Lrow

End With



With ActiveSheet.Select

    ViewMode = ActiveWindow.View
    ActiveWindow.View = xlNormalView

    .DisplayPageBreaks = False


    Firstrow = 7
    Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row


    For Lrow = Lastrow To Firstrow Step -1


        With .Cells(Lrow, "A")

            If Not IsError(.Value) Then

                Select Case .Value
                Case Is = "Net Change", "Totals:": .EntireRow.Delete
                End Select

            End If


        End With

    Next Lrow

    End With





  Range("A50000").Select
 Selection.End(xlUp).Offset(-1, 0).Select
 Selection.Insert Shift:=xlToRight
 Selection.EntireRow.Insert

 Range("A50000").Select
Selection.End(xlUp).Offset(-1, 0).Select
 Selection.Insert Shift:=xlToRight


   Range("A50000").Select
Selection.End(xlUp).Offset(0, 0).Select
 Selection.Insert Shift:=xlToRight

 Columns("F").ColumnWidth = 20



With ActiveSheet.PageSetup
.PrintTitleRows = "$1:$8"
.Orientation = xlLandscape
.Zoom = False
.FitToPagesWide = 1
.FitToPagesTall = False
End With

 Rows("9:9").Select
ActiveWindow.FreezePanes = True`

Answer 1

我对您的代码进行了一些更改，删除了一些不必要的Select语句（尽管不是全部都不确定结束部分的作用）。也不要认为你需要两个循环来插入然后删除行。

Sub x()

Dim ws As Worksheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long

With Application
    CalcMode = .Calculation
    .Calculation = xlCalculationManual
    .ScreenUpdating = False
End With

For Each ws In Worksheets
    If ws.Name Like "Denver*" Then
        ws.Cells.EntireColumn.AutoFit
        ws.Columns("A:A").ColumnWidth = 12

        ws.Columns("A:A").Replace What:="X", Replacement:="", LookAt:=xlPart, _
            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
            ReplaceFormat:=False

        ViewMode = ActiveWindow.View
        ActiveWindow.View = xlNormalView

        With ws
           .DisplayPageBreaks = False
            Firstrow = 9
            Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
            For Lrow = Lastrow To Firstrow Step -1
                With .Cells(Lrow, "A")
                    If Not IsError(.Value) Then
                        Select Case .Value
                        Case Is = "Denver", "Inactive", "System:": .EntireRow.Delete
                        End Select
                    End If
                End With
            Next Lrow
        End With

        With ws
            Firstrow = 7
            For Lrow = Lastrow To Firstrow Step -1
                With .Cells(Lrow, "A")
                    If Not IsError(.Value) Then
                        Select Case .Value
                        Case Is = "Net Change", "Account:": .EntireRow.Insert
                        End Select
                    End If
                End With
            Next Lrow
        End With

        With ws
            For Lrow = Lastrow To Firstrow Step -1
                With .Cells(Lrow, "A")
                    If Not IsError(.Value) Then
                        Select Case .Value
                        Case Is = "Net Change", "Totals:": .EntireRow.Delete
                        End Select
                    End If
                End With
            Next Lrow
        End With

        ws.Range("A50000").End(xlUp).Offset(-1, 0).Resize(, 2).Insert shift:=xlToRight
        ws.Range("A50000").End(xlUp).Offset(-1, 0).EntireRow.Insert
        ws.Range("A50000").End(xlUp).Insert shift:=xlToRight
        ws.Columns("F").ColumnWidth = 20

        With ws.PageSetup
            .PrintTitleRows = "$1:$8"
            .Orientation = xlLandscape
            .Zoom = False
            .FitToPagesWide = 1
            .FitToPagesTall = False
        End With

        ws.Rows("9:9").Select
        ActiveWindow.FreezePanes = True
    End If
Next ws

End Sub

用于格式化包含特定文本的工作表的宏

1 个答案: