excel 跳过工作簿中的多个工作表

5gfr0r5j  于 2023-01-18  发布在  其他
关注(0)|答案(2)|浏览(144)

我需要一个跳过多个工作表的代码,并转到Excel中的下一个工作表
我尝试使用select case和if array,但不起作用

Sub s()

    Select Case Sheet
        Case Is = "Weekly Spread (%),Weekly spread (Count)Summary,Sheet1,Consolidated_Data"
        Case Else
             t = 0
             Sheet.Select
             If t = 1 Then
                 Range("a1").Select
                 Range(Selection, Selection.End(xlToRight).End(xlDown)).Copy
             Else
                 Range("a2").Select
                 Range(Selection, Selection.End(xlToRight).End(xlDown)).Copy
             End If
            
             Sheets("LoginData").Select
             If t = 1 Then
                 Range("a1").Select
                 Selection.PasteSpecial xlPasteValues
             Else
                 Range("A1").Select
                 Selection.End(xlDown).Offset(1, 0).Select
                 Selection.PasteSpecial xlPasteValues
             End If
       
    End Select
    t = t + 1
    
End Sub
kr98yfug

kr98yfug1#

导入表格值

Option Explicit

Sub ImportData()

    Dim Exceptions(): Exceptions = Array("LoginData", "Weekly Spread (%)", _
        "Weekly spread (Count)Summary", "Sheet1", "Consolidated_Data")
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim dws As Worksheet: Set dws = wb.Sheets("LoginData")
    'dws.Cells.Clear ' clear previous data
    Dim dCell As Range: Set dCell = dws.Range("A1") ' first
    
    Dim sws As Worksheet, srg As Range, IsFirstFound As Boolean

    For Each sws In wb.Worksheets ' '.Sheets' would include charts!
        If IsError(Application.Match(sws.Name, Exceptions, 0)) Then ' not found
            If IsFirstFound Then ' it's not the first; exclude headers
                With sws.Range("A1").CurrentRegion
                    Set srg = .Resize(.Rows.Count - 1).Offset(1)
                End With
            Else ' it's the first; include headers
                Set srg = sws.Range("A1").CurrentRegion
                IsFirstFound = True
            End If
            dCell.Resize(srg.Rows.Count, srg.Columns.Count).Value = srg.Value
            Set dCell = dCell.Offset(srg.Rows.Count) ' next
        'Else ' found; it's one from the exceptions array; do nothing
        End If
    Next sws

    MsgBox "Data imported into """ & dws.Name & """.", vbInformation

End Sub

关于代码的一些想法

Sub s()
    ' Next time show us the variable declarations and the For Each...Next loop.
    
    Dim Sheet As Worksheet
    Dim t As Long ' it is already 0; my code uses a boolean 'IsFirstFound'.
    
    For Each Sheet In ThisWorkbook.Worksheets
        
        Select Case Sheet
        ' This was a major mistake. Also, 'LoginData' had to be included.
        ' Also, keep in mind that this is case sensitive i.e. e.g. 'sheet1'
        ' will not be excluded. In my code 'Application.Match' is used
        ' on an array of the names which is not case sensitive.
        Case "LoginData", "Weekly Spread (%)", _
            "Weekly spread (Count)Summary", "Sheet1", "Consolidated_Data"
        
        Case Else
            ' No need to use 'Select'. Use the 'With' statement instead.
            ' Best use variables to reference the workbook, worksheets
            ' and ranges. See 'wb', 'sws', 'dws', 'srg' and 'dCell' in my code.
            ' You needed to switch 'A1' and 'A2', or use 'If t = 0 Then'.
            ' It is very risky to use 'xlToRight' and 'xlDown' with 'A2' i.e.
            ' if a single cell in row 2 is empty, the wrong range
            ' will be referenced. The same goes for 'xlDown' in column 'A'
            ' while pasting.
            ' See the use of 'CurrentRegion', 'Resize' and 'Offset' in my code.
            ' Copying by assignment is faster and doesn't mess with
            ' the selection like 'PasteSpecial' does.
            
            ' The following two blocks of code are highly unreliable.
            ' You could call it a first step in getting rid of 'Select'.
            
            With Sheet
                If t = 0 Then ' first worksheet
                    .Range(.Range("A1"), .Range("A1").End(xlToRight).End(xlDown)).Copy
                Else ' all but the first worksheet
                    .Range(.Range("A2"), .Range("A2").End(xlToRight).End(xlDown)).Copy
                End If
            End With
            
            With ThisWorkbook.Sheets("LoginData")
                If t = 0 Then ' first worksheet
                    .Range("A1").PasteSpecial xlPasteValues
                Else ' all but the first worksheet
                    .Range("A1").End(xlDown).Offset(1, 0).PasteSpecial xlPasteValues
                End If
            End With
        
        End Select
        
        t = 1 ' since 'If T = 0 Then' is used (switches to all but the first)
    
    Next Sheet

    ' There are too many issues for such a code to be reliable!
    ' It will work until it doesn't which may be sooner than you expect.

End Sub
eagi6jfj

eagi6jfj2#

代码更改假设您要迭代当前工作簿上的工作表。我认为您需要将LoginData添加到列表中以避免从同一工作表复制数据。

Sub s()
    For Each Sheet In ThisWorkbook.Sheets
        Select Case Sheet.Name
            ' I think yo need to add LoginData to this list to avod copying into itself
            Case "Weekly Spread (%)", "Weekly spread (Count)Summary", "Sheet1", "Consolidated_Data"
            Case Else
                 t = 0
                 Sheet.Select
                 If t = 1 Then   'Why the difference here? I do understand it in the paste but not here
                     Range("a1").Select
                     Range(Selection, Selection.End(xlToRight).End(xlDown)).Copy
                 Else
                     Range("a2").Select
                     Range(Selection, Selection.End(xlToRight).End(xlDown)).Copy
                 End If
                
                 Sheets("LoginData").Select
                 If t = 1 Then
                     Range("a1").Select
                     Selection.PasteSpecial xlPasteValues
                 Else
                     Range("A1").Select
                     Selection.End(xlDown).Offset(1, 0).Select
                     Selection.PasteSpecial xlPasteValues
                 End If
           
        End Select
        t = t + 1
    Next Sheet
End Sub

相关问题