Question

我使用插件将Salesforce.com中的62个报告导入Excel。插件将每个报表放在工作表中的单独选项卡上（这是完美的）。以前，我正在复制并粘贴到另一个镜像副本的工作表中，除了它在每个选项卡上设置了表。我正在寻找一种方法来减少我的复制并设置一个宏，它将自动选择选项卡上的范围，创建一个表，并继续所有62个选项卡。我遇到的问题是每个标签包含可变数量的行。

我的部分格式化宏的范围低至第580行，这是我为文本颜色格式化特定单元格的安全距离。由于我一直在努力创建表格，这使我的工作变得复杂，因为它创建表格一直到第580行。如果有办法只选择具有特定列的数据的单元格（减去行）一个可能是表头的，也可以工作。我只需要表包含包含信息的行。

我已经提交了我使用的当前宏：

Sub SAR_Format()
'
' SAR_Format Macro
' SAR Table Formating
'

'
    Dim ws As Worksheet
    For Each ws In Sheets
    ws.Activate
    Columns("A:A").EntireColumn.AutoFit
    Columns("B:B").EntireColumn.AutoFit
    Columns("C:G").Select
    Selection.ColumnWidth = 7.86
    Selection.ColumnWidth = 10
    Columns("H:H").Select
    Columns("H:H").EntireColumn.AutoFit
    Columns("I:I").EntireColumn.AutoFit
    Columns("J:J").EntireColumn.AutoFit
    Columns("K:K").EntireColumn.AutoFit
    Columns("L:L").ColumnWidth = 8.86
    Columns("L:L").ColumnWidth = 7.57
    Rows("1:1").RowHeight = 29.25
        With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
        End With
        Columns("M:M").EntireColumn.AutoFit
    Columns("N:N").EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 2
    Columns("N:N").EntireColumn.AutoFit
    Columns("O:O").EntireColumn.AutoFit
    Columns("P:P").EntireColumn.AutoFit
    ActiveWindow.ScrollColumn = 1
    Range("C2:G580").Select
    Selection.NumberFormat = "$#,##0_);[Red]($#,##0)"
    With Selection.Font
        .Color = -65536
        .TintAndShade = 0
    End With
    Range("A2:P580").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 10
         End With
         ActiveWindow.SmallScroll Down:=-348
    ActiveWindow.ScrollRow = 191
    ActiveWindow.ScrollRow = 189
    ActiveWindow.ScrollRow = 186
    ActiveWindow.ScrollRow = 184
    ActiveWindow.ScrollRow = 179
    ActiveWindow.ScrollRow = 174
    ActiveWindow.ScrollRow = 167
    ActiveWindow.ScrollRow = 159
    ActiveWindow.ScrollRow = 149
    ActiveWindow.ScrollRow = 141
    ActiveWindow.ScrollRow = 133
    ActiveWindow.ScrollRow = 124
    ActiveWindow.ScrollRow = 118
    ActiveWindow.ScrollRow = 89
    ActiveWindow.ScrollRow = 86
    ActiveWindow.ScrollRow = 82
    ActiveWindow.ScrollRow = 79
    ActiveWindow.ScrollRow = 76
    ActiveWindow.ScrollRow = 74
    ActiveWindow.ScrollRow = 71
    ActiveWindow.ScrollRow = 70
    ActiveWindow.ScrollRow = 67
    ActiveWindow.ScrollRow = 65
    ActiveWindow.ScrollRow = 63
    ActiveWindow.ScrollRow = 48
    ActiveWindow.ScrollRow = 45
    ActiveWindow.ScrollRow = 43
    ActiveWindow.ScrollRow = 40
    ActiveWindow.ScrollRow = 38
    ActiveWindow.ScrollRow = 35
    ActiveWindow.ScrollRow = 32
    ActiveWindow.ScrollRow = 30
    ActiveWindow.ScrollRow = 28
    ActiveWindow.ScrollRow = 26
    ActiveWindow.ScrollRow = 25
    ActiveWindow.ScrollRow = 23
    ActiveWindow.ScrollRow = 20
    ActiveWindow.ScrollRow = 18
    ActiveWindow.ScrollRow = 16
    ActiveWindow.ScrollRow = 15
    ActiveWindow.ScrollRow = 13
    ActiveWindow.ScrollRow = 11
    ActiveWindow.ScrollRow = 10
    ActiveWindow.ScrollRow = 9
    ActiveWindow.ScrollRow = 8
    ActiveWindow.ScrollRow = 6
    ActiveWindow.ScrollRow = 5
    ActiveWindow.ScrollRow = 3
    ActiveWindow.ScrollRow = 2

    Next ws
End Sub

此宏修复了我的列宽，为特定单元格提供了适当的字体大小，格式和颜色，但不创建表格。

Answer 1

我对原始代码进行了一些修改（请参阅代码中的注释）。此解决方案假定报告数据从A1

开始

Sub SAR_Format()
Dim Wsh As Worksheet, Lob As ListObject
Dim rSrc As Range, lRowLst As Long

    Rem Loop Through Each Worksheet in Workbook
    For Each Wsh In ThisWorkbook.Worksheets  'Use this line if procedure is in the workbook with data
    'For Each ws In Workbooks("WbkName").Sheets  'Use this line if procedure is not in the workbook with data - update workbook name

        With Wsh

            Rem Set Source Range
            Application.Goto .Cells(1), 1
            lRowLst = .Cells(.Rows.Count, 1).End(xlUp).Row     'Get Last row of data
            Set rSrc = .Range("A1:P" & lRowLst)

            Rem Add ListObject - Excel Table
            Set Lob = .ListObjects.Add(xlSrcRange, rSrc, , xlYes)

        End With

        Rem Work with Excel Table (ListObject in VBA)
        With Lob
            .TableStyle = "TableStyleMedium6"
            .ShowTableStyleRowStripes = False

            Rem Header Settings
            With .HeaderRowRange
                .RowHeight = 29.25

                'It's not clear if this setting corresponds to the header or to columns H
                'I have it in both just delete the one no needed
                .HorizontalAlignment = xlGeneral
                .VerticalAlignment = xlBottom
                .WrapText = True
                .Orientation = 0
                .AddIndent = False
                .IndentLevel = 0
                .ShrinkToFit = False
                .ReadingOrder = xlContext
                .MergeCells = False
            End With

            Rem Body Settings
            With .DataBodyRange
                With Range(.Columns(3), .Columns(7))
                    .NumberFormat = "$#,##0_);[Red]($#,##0)"
                    .Font.Color = RGB(0, 0, 255)
                End With

                'It's not clear if this setting corresponds to the header or to columns H
                'I have it in both just delete the one no needed
'                With .Columns(8)
'                    .HorizontalAlignment = xlGeneral
'                    .VerticalAlignment = xlBottom
'                    .WrapText = True
'                    .Orientation = 0
'                    .AddIndent = False
'                    .IndentLevel = 0
'                    .ShrinkToFit = False
'                    .ReadingOrder = xlContext
'                    .MergeCells = False
'                End With
            End With

            Rem General Settings
            With .Range
                .Font.Name = "Calibri"
                .Font.Size = 10
                .EntireColumn.AutoFit
                .Columns(12).ColumnWidth = 7.57
                Range(.Columns(3), .Columns(7)).ColumnWidth = 10
            End With

    End With: Next

End Sub

建议访问这些页面：

Variables & Constants，Application Object (Excel)，Excel Objects

With Statement，Range Object (Excel)，ListObject Members (Excel)

请告诉我您可能对该代码提出的任何问题。

跨多个标签

1 个答案: