我修改了代码,我将供应商作为工作表名称,但它似乎没有在所有工作表中运行我的代码

时间:2015-03-31 16:39:37

标签: vba excel-vba excel

原始代码:

Sub LoopThroughSheets()

Dim Months As Variant
Dim Month As Variant

Months = Array("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", _
         "Aug", "Sep", "Oct", "Nov", "Dec")

For Each Month In Months
    'Code goes here.
Next Month

End Sub

修改后的代码:

Sub LoopThroughSheets()

Dim Suppliers As Variant
Dim Supplier As Variant

Suppliers = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", _
         "J", "K", "L", "M", "N", "O", "P", "Q")

For Each Supplier In Suppliers
    'Code goes here.
Next Supplier

End Sub

2 个答案:

答案 0 :(得分:0)

如果您的标签是"字母"

,则可以使用以下模板
Sub LoopThroughSheets()
    Dim Suppliers As Variant, Supplier As Variant
    Suppliers = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")
    For Each Supplier In Suppliers
        With Sheets(Supplier)
            .Range("A1").Value = "qwerty"
        End With
    Next Supplier
End Sub

答案 1 :(得分:0)

Sub RefreshFormulas2()
'
' RefreshFormulas2 Macro
'
' Sub LoopThroughSheets()

Dim Suppliers As Variant
Dim Supplier As Variant
Dim rng As Range
Dim UnusedColumn As Range

Application.ScreenUpdating = False

Suppliers = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L", "M", "N", "O", "P", "Q")

For Each Supplier In Suppliers
  With Sheets(Supplier)
    .Range("A1").Value = ""
    'PURPOSE: Selects only cells with values or formulas and excludes blank values (ie ="" or +"")
    Range("AG4").Select
    Selection.Copy
    Set rng = Range("C4:C100")
    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)
   'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False

    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear
    Range("AI4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Set rng = Range("E4:E100")

    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)

    'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
              SkipBlanks:=False, Transpose:=False
    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear

    Range("AJ4").Select
    Application.CutCopyMode = False
    Selection.Copy

    Set rng = Range("F4:F100")

    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)

    'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
              SkipBlanks:=False, Transpose:=False
    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear

    Range("AK4").Select
    Application.CutCopyMode = False
    Selection.Copy

    Set rng = Range("G4:G100")

    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)

    'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear

    Range("AL4").Select
    Application.CutCopyMode = False
    Selection.Copy

    Set rng = Range("H4:H100")

    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)

    'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select

    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear

    Range("AN4").Select
    Application.CutCopyMode = False
    Selection.Copy
    Set rng = Range("J4:J100")

    'Find a column with nothing in it
    Set UnusedColumn = Cells.Find("*", , xlFormulas, , xlByColumns, xlPrevious).EntireColumn.Offset(0, 1)

    'Create temporary calculation column to determine which cells to select (marked by an X)
    Intersect(rng.EntireRow, UnusedColumn) = Evaluate("IF(" & rng.Address & "="""","""",""X"")")

    'Make Selection
    Intersect(UnusedColumn.SpecialCells(xlConstants).EntireRow, rng.EntireColumn).Select
    ActiveSheet.Paste
    Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
    SkipBlanks:=False, Transpose:=False
    'Remove Temporary Blank Caluclations
    UnusedColumn.Clear
    ActiveSheet.Range("I4:I95").ClearContents

    ActiveSheet.Range("K5").Select
    Application.CutCopyMode = False
  End With

Next Supplier

End Sub