Excel VBA在一系列工作簿上循环访问工作表

时间:2015-03-12 15:20:25

标签: excel vba excel-vba

我有一个主宏工作簿,其唯一目的是运行一个循环遍历特定文件夹中所有工作簿的宏,进行一系列更改,然后将它们保存到另一个文件夹中。

除了一些新代码我想循环遍历所有不同的工作表之外,所有这些都有效。代码只是一遍又一遍地在第一个工作表上运行代码。

    Sub BlendBCoding()
    Dim Filename, Pathname As String
    Dim wb As Workbook
    Dim ws As Worksheet
    Dim NameOfWorkbook
    Dim cel As Variant
    Dim myrange As Range

    Pathname = ActiveWorkbook.Path & "\ToProcess\"
    Filename = Dir(Pathname & "*.xml")
    Do While Filename <> ""
    Set wb = Workbooks.Open(Pathname & Filename)

    For Each ws In wb.Sheets

    Call DoWork(ws)

    Next

        NameOfWorkbook = Left(ActiveWorkbook.Name, (InStrRev(ActiveWorkbook.Name, ".", -1, vbTextCompare) - 1))
            ActiveWorkbook.SaveAs Filename:= _
        "I:\Common\BlendBCoding\Processed\" & NameOfWorkbook & ".xlsx", FileFormat _
        :=xlOpenXMLWorkbook, CreateBackup:=False

        wb.Close SaveChanges:=False
        Filename = Dir()
    Loop

End Sub

Sub DoWork(ws As Worksheet)
    With ws
        Range("A1:G1").EntireColumn.Insert
        Range("A1").Value = "Scan Components"
        Range("A1").ColumnWidth = 16
        //Blah Blah lots of standard text code cut

        Set myrange = Range("H1:H100")
        myrange.Interior.ColorIndex = xlNone
        For Each cel In myrange
        If Application.WorksheetFunction.CountIf(myrange, cel) > 1 Then
        cel.Interior.ColorIndex = 4
        End If
        Next

        'Set myrange = Range("H2:H25")
        'For Each xCell In myrange
        ' xCell.Value = CDec(xCell.Value)
        ' Next xCell

    End With
End Sub

非常感谢任何帮助。

1 个答案:

答案 0 :(得分:2)

您未指向ws

中的范围

事先使用.,否则您将引用ActiveSheet

With ws
        .Range("A1:G1").EntireColumn.Insert
        .Range("A1").Value = "Scan Components"
        .Range("A1").ColumnWidth = 16
        //Blah Blah lots of standard text code cut

        Set myrange = .Range("H1:H100")
        myrange.Interior.ColorIndex = xlNone
        For Each cel In myrange
        If Application.WorksheetFunction.CountIf(myrange, cel) > 1 Then
        cel.Interior.ColorIndex = 4
        End If
        Next


End With