遍历所有工作表并查找范围内的值。如果找到然后执行一些操作并转到

Posted 2023-03-27

【中文标题】遍历所有工作表并查找范围内的值。如果找到然后执行一些操作并转到

【英文标题】：Loop through all sheets and look for value in range. If found then do some action and GoTo

【发布时间】：2022-01-17 13:24:21

【问题描述】：

我在下面有一段非常简单的代码。我需要它遍历工作簿中的所有工作表并查找范围内的特定值。如果找到，则执行一些操作（获取工作表名称并存储在临时工作表中）并转到另一行以完成其余代码。 只有一个工作表将包含此值或不包含此值。因此，如果在任何这些工作表中都找不到此值，我想从 Step2 运行代码。工作簿甚至可以包含 20-30 张。

如果我在禁用 Else 的情况下运行此代码，它工作正常。它找到工作表，完成 If 并执行其余代码

但是，如果在任何工作表中都找不到值，我想转到第 2 步到其他子页面。但是每当我有这个 Else: GoTo Step2: enabled 它就会进入 Step2: 就在检查第一张没有搜索值的工作表之后。

知道我做错了什么。这是一段简单的代码，我对此感到很疯狂:)

Sub ProjectGCA1 ()

 Application.ScreenUpdating = False
 
 Dim ws, shGCA1 As Worksheet
    Dim wb As Workbook
        Dim i, j As Long
        
    Set wb = ThisWorkbook
               wb.Sheets.Add.Name = "Temporary storage"
            j = wb.Sheets.Count

   For i = 1 To j
    
        If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
            Set shGCA1 = wb.Sheets(i)
            wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
                wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
       
           'Else: GoTo Step2:

        End If
    Next i
Step1: 

' -----------------------rest of the code to work on shGCA1------------------------
' -----------------------rest of the code to work on shGCA1------------------------

Step2
Call ProjectGCA2

End Sub

【参考方案1】：

如果您在循环中激活 else within，那么循环当然会在第一次迭代时保留。如果找到工作表，您需要在循环完成后检查。 据我了解，您正在将shGCA1 设置为您找到的工作表，因此您可以检查它是否已设置。如果您没有这样的变量，只需创建一个布尔变量并在找到某些内容时将其设置为 True。重要的是在循环完成后检查它。

For i = 1 To j
    If wb.Sheets(i).Range("A4") = "Project Name: GCA1" Then
        Set shGCA1 = wb.Sheets(i)
        wb.Sheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
        wb.Sheets("Temporary storage").Range("B1").Value = wb.Sheets(i).Name
        ' If you are sure there is at most one sheet, you can leave the loop now:
        Exit For
    End If
Next i

If Not shGCA1 Is Nothing then
    ' Do your stuff with the sheet.
Else
    ' Do the stuff if no sheet was found
End If

如果程序的行为不清楚，我强烈建议使用调试器并逐行执行代码（使用 F8）

【讨论】：

感谢您的帮助。这似乎很明显，不知道我为什么要为此苦苦挣扎。非常感谢。经验教训:)

【参考方案2】：

单元格中包含字符串的参考工作表

您可以使用以下函数来引用找到的工作表：

Function RefWorksheetWithStringInCell( _
    ByVal wb As Workbook, _
    ByVal CellAddress As String, _
    ByVal CellString As String, _
    Optional ByVal MatchCase As Boolean = False) _
As Worksheet
    Const ProcName As String = "RefWorksheetWithStringInCell"
    On Error GoTo ClearError
    
    Dim CompareMethod As VbCompareMethod
    CompareMethod = IIf(MatchCase = False, vbTextCompare, vbBinaryCompare)
    
    Dim ws As Worksheet
    For Each ws In wb.Worksheets
        If StrComp(CStr(ws.Range(CellAddress).Value), CellString, _
                CompareMethod) > 0 Then
            Set RefWorksheetWithStringInCell = ws
            Exit For
        End If
    Next ws

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

然后您可以通过以下方式重写您的代码：

' Now the loop is in the function.
Set shGCA1 = RefWorksheetWithStringInCell(wb, "A4", "Project Name: GCA1")

If shGCA1 Is Nothing Then ' not found
    ProjectGCA2 ' 'Call' is considered deprecated
    Exit Sub
Endif    

wb.Worksheets("Temporary storage").Range("A1").Value = "Project Name: GCA1"
wb.Worksheets("Temporary storage").Range("B1").Value = shGCA1.Name
' Continue...

这里有一个函数可以让您控制添加工作表，例如如果它已经存在：

Function RefAddedWorksheet( _
    ByVal wb As Workbook, _
    ByVal WorksheetName As String, _
    Optional ByVal DoKeepExisting As Boolean = False) _
As Worksheet
    Const ProcName As String = "RefAddedWorksheet"
    On Error GoTo ClearError ' e.g. invalid sheet name

    Dim sh As Object ' e.g. chart
    Dim DoesWorksheetExist As Boolean
    
    On Error Resume Next
        Set sh = wb.Sheets(WorksheetName)
    On Error GoTo ClearError
    
    If Not sh Is Nothing Then ' sheet already exists
        If sh.Type = xlWorksheet Then ' is worksheet
            If DoKeepExisting Then ' keep
                DoesWorksheetExist = True ' flag it existing
            'Else ' don't keep
            End If
        'Else ' is chart
        End If
        If Not DoesWorksheetExist Then ' not flagged existing
            Application.DisplayAlerts = False ' delete without confirmation
                sh.Delete
            Application.DisplayAlerts = True
        'Else ' flagged existing
        End If
    'Else ' sheet doesn't exist
    End If
    
    If Not DoesWorksheetExist Then ' not flagged existing
        Set sh = wb.Worksheets.Add(After:=wb.Sheets(wb.Sheets.Count))
        On Error Resume Next
            sh.Name = WorksheetName
        On Error GoTo ClearError
    'Else ' flagged existing
    End If
    
    If StrComp(sh.Name, WorksheetName, vbTextCompare) = 0 Then ' valid name
        Set RefAddedWorksheet = sh
    Else ' invalid name
        Application.DisplayAlerts = False ' delete without confirmation
            sh.Delete
        Application.DisplayAlerts = True
    End If

ProcExit:
    Exit Function
ClearError:
    Debug.Print "'" & ProcName & "': Unexpected Error!" & vbLf _
              & "    " & "Run-time error '" & Err.Number & "':" & vbLf _
              & "    " & Err.Description
    Resume ProcExit
End Function

在您的代码中，您可以例如按以下方式使用它：

Const wsTempName As String = "Temporary storage"
Const wsTempDoKeepExisting As Boolean = False

Dim wsTemp As Worksheet
Set wsTemp = RefAddedWorksheet(wb, wsTempName, wsTempDoKeepExisting)

If wsTemp Is Nothing Then ' highly unlikely (if invalid name e.g. 'History')
    MsgBox "Could not create the '" & wsTempName & "' worksheet.", _
        vbCritical
    Exit Sub
End If

请注意，该函数将工作表添加到工作簿中的最后一张工作表之后。