我怎么能阻止这个vba循环?

问题描述 投票:1回答:2

我正在研究一个宏来循环我在工作簿中的所有工作表中的步骤,如下所示。但是,它似乎是一个错误:

运行时错误'1004':“选择工作表类的方法失败”

Sub WorksheetLoopFormat()

     Dim WS_Count As Integer
     Dim i As Integer

     ' Set WS_Count equal to the number of worksheets in the active
     ' workbook.
     WS_Count = ActiveWorkbook.Worksheets.Count

     ' Begin the loop.
     For i = 2 To WS_Count

        Sheets(i).Select
        Range("C:C,G:G,I:I,AN:AN").Select
        Range("AN1").Activate
        Selection.Copy
        Sheets.Add After:=ActiveSheet
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
        Range("C30").Select
        Sheets(i).Select
        Application.CutCopyMode = False
        ActiveWindow.SelectedSheets.Delete

     Next i

  End Sub

希望会有人帮助我!!非常感谢!!

excel vba
2个回答
0
投票

Transform Workbook

  • 将每个(源)工作表的一系列不连续的列复制到新添加的(目标)工作表,然后删除源工作表并将目标工作表重命名为源工作表的名称。
  • 仅处理不在“例外列表”中的工作表。如果工作簿中有图表,程序将不会失败。
  • 在简易版本中,您必须小心不要运行程序两次,因为您不喜欢结果。在高级版本中可以防止这种情况。

简单

Sub WorksheetLoopFormatEasy()

    Const cExc As String = "Sheet1"             ' Worksheet Exception List
    Const cSrc As String = "C:C,G:G,I:I,AN:AN"  ' Source Range Address
    Const cTgt As String = "A1"                 ' Target Cell Range Address
    Dim wsS As Worksheet  ' Source Worksheet
    Dim wsT As Worksheet  ' Target Worksheet
    Dim vntE As Variant   ' Exception Array
    Dim i As Long         ' Exception Array Element (Name) Counter
    Dim strS As String    ' Source Worksheet Name

    ' Copy Exception List to Exception Array.
    vntE = Split(cExc, ",")

    ' In This Workbook (i.e. the workbook containing this code.)
    With ThisWorkbook
        ' Loop through all Source Worksheets.
        For Each wsS In .Worksheets
            ' Loop through elements (names) of Exception Array.
            For i = 0 To UBound(vntE)
                ' Check if current name in exception array equals the current
                ' Worksheet name.
                If Trim(vntE(i)) = wsS.Name Then Exit For ' Match found
            Next
            ' Note: Exception Array is a zero-based one-dimensional array.
            ' If a match is NOT found, "i" will be equal to the number of
            ' names in Exception Array (i.e. UBound(vntE) + 1).
            If i = UBound(vntE) + 1 Then
                ' Add a new worksheet (Target Worksheet) after Source Worksheet.
                ' Note:   The newly added worksheet will become the ActiveSheet
                '         and will become the Target Worksheet.
                .Sheets.Add After:=wsS
                ' Create a reference to Target Worksheet.
                Set wsT = .ActiveSheet
                ' Copy Source Range to Target Range.
                wsS.Range(cSrc).Copy Destination:=wsT.Range(cTgt)
                ' Write source worksheet name to Source Worksheet Name.
                strS = wsS.Name
                ' Delete Source Worksheet.
                ' Note:   Disabling DisplayAlerts suppresses showing
                '         of the 'delete message box'.
                Application.DisplayAlerts = False
                wsS.Delete
                Application.DisplayAlerts = True
                ' Rename Target Worksheet to Source Worksheet Name.
                wsT.Name = strS
            End If
        Next
    End With

    MsgBox "The program has finished successfully.", vbInformation, "Success"

End Sub

高级

Sub WorksheetLoopFormatAdvanced()

    Const cExc As String = "Sheet1"             ' Worksheet Exception List
    Const cSrc As String = "C:C,G:G,I:I,AN:AN"  ' Source Range Address
    Const cTgt As String = "A1"                 ' Target Cell Range Address
    Dim wsS As Worksheet  ' Source Worksheet
    Dim wsT As Worksheet  ' Target Worksheet
    Dim vntE As Variant   ' Exception Array
    Dim i As Long         ' Exception Array Element (Name) Counter
    Dim lngA As Long      ' Area Counter
    Dim lngC As Long      ' Source Range Columns Count(er)
    Dim strS As String    ' Source Worksheet Name
    Dim strA As String    ' ActiveSheet Name

    ' Speed up.
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
    End With

    ' Handle Errors.
    On Error GoTo ErrorHandler

    ' Copy Exception List to Exception Array.
    vntE = Split(cExc, ",")

    ' In This Workbook (i.e. the workbook containing this code.)
    With ThisWorkbook

        ' Write the name of ActiveSheet to ActiveSheet Name.
        strA = .ActiveSheet.Name

        ' Loop through all Source Worksheets.
        For Each wsS In .Worksheets

            '*******************************'
            ' Prevent Double Transformation '
            '*******************************'

            ' Calculate Source Range Columns Count if not already calculated.
            If lngC = 0 Then
                ' Loop through Areas of Source Range.
                For lngA = 1 To wsS.Range(cSrc).Areas.Count
                    ' Count the columns in current area.
                    lngC = lngC + wsS.Range(cSrc).Areas(lngA).Columns.Count
                Next
                ' Check if number of used columns in Source Worksheet is equal
                ' to the number of columns of Source Range.
                If wsS.Cells.Find("*", , xlFormulas, , xlByColumns, _
                        xlPrevious).Column - wsS.Range(cTgt).Column + 1 _
                        <= lngC Then GoTo DoubleTransformationError
            End If

            '*****************
            ' Transform Data '
            '*****************

            ' Loop through elements (names) of Exception Array.
            For i = 0 To UBound(vntE)
                ' Check if current name in exception array equals the current
                ' Worksheet name.
                If Trim(vntE(i)) = wsS.Name Then Exit For ' Match found
            Next
            ' Note: Exception Array is a zero-based one-dimensional array.
            ' If a match is NOT found, "i" will be equal to the number of
            ' names in Exception Array (i.e. UBound(vntE) + 1).
            If i = UBound(vntE) + 1 Then
                ' Add a new worksheet (Target Worksheet) after Source Worksheet.
                ' Note:   The newly added worksheet will become the ActiveSheet
                '         and will become the Target Worksheet.
                .Sheets.Add After:=wsS
                ' Create a reference to Target Worksheet.
                Set wsT = .ActiveSheet
                ' Copy Source Range to Target Range.
                wsS.Range(cSrc).Copy Destination:=wsT.Range(cTgt)
                ' Write source worksheet name to Source Worksheet Name.
                strS = wsS.Name
                ' Delete Source Worksheet.
                ' Note:   Disabling DisplayAlerts suppresses showing
                '         of the 'delete message box'.
                Application.DisplayAlerts = False
                wsS.Delete
                Application.DisplayAlerts = True
                ' Rename Target Worksheet to the name of Source Worksheet.
                wsT.Name = strS
            End If
        Next

    End With

    MsgBox "The program has finished successfully.", vbInformation, "Success"

ProcedureExit:

    ' Activate worksheet that was active before program execution.
    ThisWorkbook.Worksheets(strA).Activate

    ' Speed down.
    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With

Exit Sub

DoubleTransformationError:
    MsgBox "The program has already run.", vbInformation, _
            "Double Transformation Prevention"
    GoTo ProcedureExit

ErrorHandler:
    MsgBox "An unexpected error has  occurred. Error '" & Err.Number & "': " _
            & Err.Description, vbInformation, "Error"
    GoTo ProcedureExit

End Sub

备注

新添加的工作表将与其前任工作表具有相同的名称,但具有不同的代码名称。



0
投票

在我看来,以下所有内容可以帮助您构建一个良好的结构代码:

Option Explicit

Sub LoopSheets()

    Dim ws As Worksheet

    For Each ws In ThisWorkbook.Worksheets

        With ws
            Debug.Print .Name
        End With

    Next

  End Sub

Sub AddSheet()

    Dim ws As Worksheet

    Set ws = ThisWorkbook.Sheets.Add(After:= _
             ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))

    ws.Name = "Test"

End Sub

Sub Copy_Paste()

    Sheet1.Range("A1:D1").Copy Sheet2.Range("A1:D1")

End Sub

Sub DeleteSheet()

    ThisWorkbook.Worksheets("Test").Delete

End Sub
© www.soinside.com 2019 - 2024. All rights reserved.