excel - 循环遍历特定的工作表并返回特定的值

Question

我有以下脚本。它旨在遍历特定的工作表并返回值。所以总而言之，忽略一些工作表。我做了一个嵌套循环，忽略了一些工作表和返回值，但它不起作用。\

我希望能够从其中一些数据中提取数据，并使用工作表名称忽略其余数据。问题是它在列中返回每张纸的名称 22 次，所以我将悉尼在第一列 20 次，然后墨尔本在第 2 列中 20 次。

我希望所有工作表的名称都出现在第一列中。

Sub FinalGO()
    Application.ScreenUpdating = False

    Dim i As Integer
    Dim WS As Worksheet
    Dim L As Long

    nowMonth = Month(Now)
    nowYear = Year(Now)
    Nowday = Day(Now)

    ActiveWorkbook.Sheets.Add After:=Worksheets(Worksheets.Count)
    ActiveWorkbook.Sheets(Worksheets.Count).Name = "Summary " & Nowday & "-" & nowMonth & "-" & nowYear

    'do nothing

    ActiveSheet.Columns(1).Insert

    For i = 2 To Sheets.Count
        ActiveSheet.Cells(1, 1).Value = "Project Name"

        For Each WS In Worksheets
            Select Case WS.Name
                Case "Prices", "Home Page", "Model Digaram", "Validation & Checks", "Model Start-->", "Input|Assumptions", "Cost Assumption"
                Case Else
                    ActiveSheet.Cells(i, 1).Value = WS.Name
            End Select
        Next WS
    Next i

    Application.ScreenUpdating = True
End Sub

标签： excelvba

Answer 1

通过工作表到工作表

Option Explicit

Sub FinalGO()

    Application.ScreenUpdating = False
    ' When using turning ScreenUpdating off, it is wise to use an Error Handler,
    ' so when an error occurs, it will get turned on again.
    On Error GoTo ErrorHandler

    Dim ws As Worksheet     ' Current Worksheet
    Dim i As Long           ' Row (Cell) Counter
    Dim strName As String   ' New Worksheet Name

    ' Determine New Worksheet Name.
    strName = "Summary " & Day(Now) & "-" & Month(Now) & "-" & Year(Now)

    ' In This Workbook (The Workbook Containing This Code)
    With ThisWorkbook
         ' Check if New Worksheet already exists.
         On Error Resume Next
         Set ws = .Worksheets(strName)
         If Err Then  ' Does NOT exist.
              On Error GoTo 0
            Else      ' DOES exist.
              GoTo AlreadyDoneToday
         End If

         ' Reenable error handling.
         On Error GoTo ErrorHandler

        ' Add a New Worksheet to the last position in This Workbook.
        .Sheets.Add After:=.Sheets(.Sheets.Count)
        ' In the New Worksheet.
        With .Sheets(.Sheets.Count)
            ' Rename New Worksheet. If you already have used this code today,
            ' this line will produce an error. Delete the sheet or...
            .Name = strName
            ' Write to cell A1 in New Worksheet.
            .Cells(1, 1).Value = "Project Name"
            ' Reset Row (Cells) Counter , because 1st already contains a value.
            i = 1
            ' Loop through worksheets of This Workbook (.Parent).
            For Each ws In .Parent.Worksheets
                ' Check the Name of the Current Worksheet.
                Select Case ws.Name
                    ' Do Nothing.
                    Case "Prices", "Home Page", "Model Digaram", _
                            "Validation & Checks", "Model Start-->", _
                            "Input|Assumptions", "Cost Assumption"
                    Case Else
                        ' Count Rows (Cells).
                        i = i + 1
                        ' Write name of Current Worksheet to cell in current
                        ' Row and first column of New Worksheet.
                        .Cells(i, 1).Value = ws.Name
                End Select
            Next
        End With
    End With

Success:

    MsgBox "The operation finished successfully.", vbInformation, "Success"

SafeExit:

    Application.ScreenUpdating = True

Exit Sub

AlreadyDoneToday:

    MsgBox "You have already done this today.", vbExclamation, "Already done."
    GoTo SafeExit

ErrorHandler:

    MsgBox "An unexpected error occurred. Error '" & Err.Number & "': " _
            & Err.Description, vbCritical, "Error"
    GoTo SafeExit

End Sub