时间戳

首页 > 解决方案 > Excel VBA循环？

vba - Excel VBA循环？

问题描述

我是创建 VBA 宏的新手。我记录了下面的宏，但我需要为工作簿中的其他 18 个工作表完成此操作。我不知道如何创建一个循环。可以从这个录制的宏中完成吗？抱歉，代码太长了。此代码再次用于其他 18 个工作表，并且不确定如何创建循环。

Sheets("C3 CONW INW OPIS_CMA").Select
Range("G1").Select
ActiveCell.FormulaR1C1 = "PSTRIK"
Range("A1").Select
ActiveCell.FormulaR1C1 = "PRECID"
Range("A2").Select
ActiveCell.FormulaR1C1 = "P"
Range("A2").Select
Selection.AutoFill Destination:=Range("A2:A26"), Type:=xlFillDefault
Range("A2:A26").Select
Range("C1").Select
ActiveCell.FormulaR1C1 = "PEXCH"
Range("C2").Select
ActiveCell.FormulaR1C1 = "7"
Range("C2").Select
Selection.AutoFill Destination:=Range("C2:C26"), Type:=xlFillDefault
Range("C2:C26").Select
Columns("O:O").Select
Selection.Delete Shift:=xlToLeft
Columns("N:N").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Delete Shift:=xlToLeft
Columns("J:J").Select
Selection.Delete Shift:=xlToLeft
Columns("D:D").Select
Selection.Delete Shift:=xlToLeft
Columns("E:E").Select
Selection.Cut
Columns("G:G").Select
Selection.Insert Shift:=xlToRight
Columns("I:I").Select
Selection.Cut
Columns("K:K").Select
Selection.Insert Shift:=xlToRight
Range("I1").Select
ActiveCell.FormulaR1C1 = "PQTY"
Range("G1").Select
ActiveCell.FormulaR1C1 = "PCTYM"
Range("D1").Select
ActiveCell.FormulaR1C1 = "PFC"
Range("B1").Select
ActiveCell.FormulaR1C1 = "PACCT"

Range("J1").Select
ActiveCell.FormulaR1C1 = "PPRTCP"
Range("E1").Select
ActiveCell.FormulaR1C1 = "PSUBTY"
Range("H1").Select
ActiveCell.FormulaR1C1 = "PSBUS"
Range("H2").Select
ActiveCell.FormulaR1C1 = "0"
Selection.AutoFill Destination:=Range("H2:H23"), Type:=xlFillDefault
Range("H2:H23").Select
Columns("I:I").Select
Range("I240").Activate
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
Range("I1").Select
ActiveCell.FormulaR1C1 = "PBS"
Range("I2").Select
ActiveCell.FormulaR1C1 = "1"
Selection.AutoFill Destination:=Range("I2:I23"), Type:=xlFillDefault
Range("I2:I23").Select

再次对代码的格式感到抱歉。

标签： vbaexcel

解决方案

我稍微清理了您的代码，并将其放入以工作表为参数的子程序中。然后我制作了另一个子程序，它遍历代码所在工作簿的所有工作表，并进行指定的更改。

Option Explicit

Sub test()
    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets
        Call fix_stuff_in_the_sheet(ws)
    Next ws
End Sub

Sub fix_stuff_in_the_sheet(ws As Worksheet)

    ws.Range("G1").FormulaR1C1 = "PSTRIK"
    ws.Range("A1").FormulaR1C1 = "PRECID"
    ws.Range("A2").FormulaR1C1 = "P"
    ws.Range("A2").AutoFill Destination:=Range("A2:A26"), Type:=xlFillDefault
    ws.Range("A2:A26").FormulaR1C1 = "PEXCH"

    ws.Range("C2").FormulaR1C1 = "7"
    ws.Range("C2").AutoFill Destination:=Range("C2:C26"), Type:=xlFillDefault
    ws.Columns("N:O").Delete Shift:=xlToLeft
    ws.Columns("E:E").Delete Shift:=xlToLeft
    ws.Columns("J:J").Delete Shift:=xlToLeft

    ws.Columns("D:D").Delete Shift:=xlToLeft
    ws.Columns("E:E").Cut
    ws.Columns("G:G").Insert Shift:=xlToRight
    ws.Columns("I:I").Cut
    ws.Columns("K:K").Insert Shift:=xlToRight

    ws.Range("I1").FormulaR1C1 = "PQTY"
    ws.Range("G1").FormulaR1C1 = "PCTYM"
    ws.Range("D1").FormulaR1C1 = "PFC"
    ws.Range("B1").FormulaR1C1 = "PACCT"
    ws.Range("J1").FormulaR1C1 = "PPRTCP"

    ws.Range("E1").FormulaR1C1 = "PSUBTY"
    ws.Range("H1").FormulaR1C1 = "PSBUS"
    ws.Range("H2").FormulaR1C1 = "0"
    ws.Range("H2").AutoFill Destination:=Range("H2:H23"), Type:=xlFillDefault
    ws.Range("I240").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove

    ws.Range("I1").FormulaR1C1 = "PBS"
    ws.Range("I2").FormulaR1C1 = "1"
    ws.Range("I2").AutoFill Destination:=Range("I2:I23"), Type:=xlFillDefault

End Sub

如果您不希望在工作簿中的所有工作表上执行代码，则需要找出一种方法，让第一个函数只使用您想要的工作表作为参数来调用。

我在此处发布的 subs 中仍有一些多余的代码，例如，您首先使用字母 P 自动填充范围 A2:A26，但随后使用 PEXCH 覆盖该范围。不过，我会把它留给你来清除它。

推荐阅读