Question

我已经搜索并尝试了多种不同的代码和方法，但没有找到解决方案的运气。我正在尝试使用宏设置来格式化一个工作表，它完美地工作，并将相同的代码应用于工作簿中的所有工作表。我已经搜索了多个代码和表单数组公式但是无法将它们应用于我拥有的代码或者足够了解它们以更改需要更改的内容以使它们工作。我对宏观世界还很陌生，根本不懂编程语言。我感谢任何人的时间，他们在这方面帮助我，因为我已经挣扎了几个星期了。谢谢。以下代码是我迄今为止所拥有的：

Sub DARprintready()
'
' DARprintready Macro
'

'
    Columns("A:A").Select
    Selection.columnwidth = 2.86
    Columns("B:B").Select
    Selection.columnwidth = 4.57
    Columns("C:C").Select
    Selection.columnwidth = 13.57
    Columns("D:D").Select
    Selection.columnwidth = 8.57
    Columns("E:E").Select
    Selection.columnwidth = 20.86
    Columns("F:F").Select
    Selection.columnwidth = 8.43
    Columns("G:H").Select
    Selection.columnwidth = 9.43
    Columns("I:I").Select
    Selection.columnwidth = 9.14
    Columns("J:J").Select
    Selection.columnwidth = 9.43
    Columns("K:K").Select
    Selection.columnwidth = 50.4
    Columns("L:L").Select
    Selection.columnwidth = 9
    Range("E:E,K:K").Select
    Range("K1").Activate
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-15
    Columns("A:L").Select
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlCenter
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    ActiveWindow.SmallScroll Down:=-6
    Columns("A:A").Select
    ActiveWindow.SmallScroll Down:=-15
    Range("A1").Select
    Sheets("Header").Select
    Range("A1:L4").Select
    Selection.Copy
    Sheets("Firmwide").Select
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown
    Application.CutCopyMode = False
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = "Page &P of &N"
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.18)
        .RightMargin = Application.InchesToPoints(0.16)
        .TopMargin = Application.InchesToPoints(0.17)
        .BottomMargin = Application.InchesToPoints(0.39)
        .HeaderMargin = Application.InchesToPoints(0.17)
        .FooterMargin = Application.InchesToPoints(0.16)
        .PrintHeadings = False
        .PrintGridlines = True
        .PrintComments = xlPrintNoComments
        .PrintQuality = 600
        .CenterHorizontally = False
        .CenterVertically = False
        .Orientation = xlLandscape
        .Draft = False
        .PaperSize = xlPaperLetter
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 80
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
End Sub

Answer 1

要在其他答案中添加一点，请使用with语句作为所有更改的简写，这样您就不必一遍又一遍地键入工作表名称

Sub ColWidth()
    Dim wkst As Worksheet
    For Each wkst In ThisWorkbook.Sheets
        With wkst
            .Columns("A:A").ColumnWidth = 2.86
            .Columns("B:B").ColumnWidth = 4.57
            .Columns("C:C").ColumnWidth = 13.57
            .Columns("D:D").ColumnWidth = 8.57
        End With
    Next

End Sub

（你必须将其余部分用于此表格）

另外，请考虑将列宽保留在数组中，并将它们分配给循环中的列。它不会加速，但你的代码会更紧凑，而且我认为可读。

，例如，

Dim i As Integer
Dim widths() As Variant
widths = Array(4.5, 3.67, 5, 6.45, 10)

For i = 1 To 5
    Columns(i).ColumnWidth = widths(i) `Thank you iDevlop for the less Rube Goldberg approach
Next

这样，您可以随意添加更多列，而无需输入任何内容。

Answer 2

第1步将学习一些VBA。幸运的是，您正在尝试的任务不需要您学习吨。

假设您在所有工作表上需要完全相同的格式，您需要遍历工作表。

为了做到这一点，你需要做3件事。

为目标工作表名称
将您的格式设置放在遍历每张表的循环中
使用变量名称

您的代码最终将会是这样的

Sub DARprintready() ' ' DARprintready Macro '
dim Outputsheet as workhsheet

for each Outputsheet in activeworkbook.sheets

  outputsheet.select
  'your formatting code here


next

您需要通过引用刚创建的变量来更改公司范围内的明确引用。

替换这个：

Sheets("Firmwide").Select

用这个：

Outputsheet.Select

希望有所帮助，

Answer 3

像往常一样，我有点晚了，但这是一个更好的解决方案。如果您觉得这是一个更好的解决方案，请随意将我的标记为正确。这样可以一次性格式化所有工作表，避免循环，并且速度更快，因为它是循环发生的Excel内部。

    Dim shs As Sheets, wks As Worksheet
    Dim rFormat As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2"))

    shs.Select

    Set rFormat = wks.Range("A1:A2,C3:C4")
    rFormat.Select
    With Selection
        .Font.ColorIndex = 3
        .Interior.ColorIndex = 6
        .Interior.Pattern = xlSolid
    End With

    wks.Select

Answer 4

快速方法：

   Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
   Columns("A:E").EntireColumn.AutoFit

Answer 5

以上代码在我的情况下不起作用，因为缺少它来激活3个（或更多）工作表之一进行格式化。由于我花了一些时间来解决此问题，因此我将共享这段代码。可以改善这一点，例如，将数组也用于格式模式。

Sub PivotTabsFormatting()
'
' PivotTabsFormatting Macro
' This formats a column range columns on multiple sheets
' Keyboard Shortcut: Ctrl+a
' By PhB- Dec'18
'
Dim shs As Sheets
Dim wks As Worksheet
Dim rFormat1 As Range
Dim rFormat2 As Range

    Set wks = ActiveWorkbook.Worksheets("Sheet1")
    Set shs = ActiveWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3"))
    Set rFormat1 = wks.Columns("D:O") 'could also be :  .Range("D4:M10")
    Set rFormat2 = wks.Columns("B:C") 'could also be :  .Range("B6:C6")

    shs.Select
    wks.Activate ' --> this was missing

    With rFormat1
        .ColumnWidth = 15
    End With

    With rFormat2
        .EntireColumn.AutoFit
    End With

    wks.Select
    wks.Range("A1").Select

End Sub

在多个工作表中应用格式

5 个答案: