VBA LOOP在所有工作表上都创建相同的标题吗?

时间:2018-08-06 13:23:22

标签: excel vba excel-vba

我想在所有工作表的第1行上放置相同的内容。我将如何创建一个循环来做到这一点?我是VBA的新手。我录制了一个宏,但是它仍然很长。需要18个工作表。这是录制的宏的样子。

Sheets("C3 MBEL TET OPIS_CMA").Select
Range("F1").Select
ActiveCell.FormulaR1C1 = "PSTRIK"
Range("A1").Select
ActiveCell.FormulaR1C1 = "PRECID"
Range("C1").Select
ActiveCell.FormulaR1C1 = "PEXCH"
Range("J1").Select
ActiveCell.FormulaR1C1 = "PQTY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PCTYM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PFC"
Range("B1").Select
ActiveCell.FormulaR1C1 = "PACCT"
Range("K1").Select
ActiveCell.FormulaR1C1 = "PPRTCP"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PSUBTY"
Range("H1").Select
ActiveCell.FormulaR1C1 = "PSBUS"
Range("I1").Select
ActiveCell.FormulaR1C1 = "PBS"

当然,除了使用不同的工作表名称外,还会重复执行17次。

1 个答案:

答案 0 :(得分:4)

您可以使用数组存储要写入页眉的工作表名称,然后循环遍历该数组以编写表头。

Option Explicit

Public Sub WriteHeaderIntoSheets()
    Dim WorksheetNames As Variant
    WorksheetNames = Array("C3 MBEL TET OPIS_CMA", "Sheet1", "Sheet2", "Sheet3") 'your sheet names

    Dim ws As Variant
    For Each ws In WorksheetNames 
        With Worksheets(ws)
            .Range("F1").FormulaR1C1 = "PSTRIK"
            .Range("A1").FormulaR1C1 = "PRECID"
            .Range("C1").FormulaR1C1 = "PEXCH"
            .Range("J1").FormulaR1C1 = "PQTY"
            .Range("G1").FormulaR1C1 = "PCTYM"
            .Range("D1").FormulaR1C1 = "PFC"
            .Range("B1").FormulaR1C1 = "PACCT"
            .Range("K1").FormulaR1C1 = "PPRTCP"
            .Range("E1").FormulaR1C1 = "PSUBTY"
            .Range("H1").FormulaR1C1 = "PSBUS"
            .Range("I1").FormulaR1C1 = "PBS"
        End With
    Next ws
End Sub

或者,您还可以在标题行中使用一个数组,这样可以使其更快。

Option Explicit

Public Sub WriteHeaderIntoSheets()
    Dim WorksheetNames As Variant
    WorksheetNames = Array("C3 MBEL TET OPIS_CMA", "Sheet1", "Sheet2", "Sheet3") 'your sheet names

    Dim HeaderRow As Variant 'your header values
    HeaderRow = Array("PRECID", "PACCT", "PEXCH", "PFC", "PSUBTY", "PSTRIK", "PCTYM", "PSBUS", "PBS", "PQTY", "PPRTCP")

    Dim ws As Variant
    For Each ws In WorksheetNames
        Worksheets(ws).Range("A1").Resize(ColumnSize:=1 + UBound(HeaderRow)).Value = HeaderRow
    Next ws
End Sub