遍歷所有作業表并查找范圍內的值。如果找到，則執行一些操作并轉到

我在下面有一段非常簡單的代碼。我需要它遍歷作業簿中的所有作業表并查找范圍內的特定值。如果找到，則執行一些操作（獲取作業表名稱并存盤在臨時作業表中）并轉到另一行以完成其余代碼。只有一個作業表將包含此值或不包含此值。因此，如果在任何這些作業表中找不到該值，我想從 Step2 運行代碼。作業簿甚至可以包含 20-30 頁。

如果我在禁用 Else 的情況下運行此代碼，則它可以正常作業。它找到作業表，完成 If 并執行其余的代碼

但是，如果在任何作業表中都找不到值，我想轉到步驟 2 到其他子程式。但是每當我有這個 Else: GoTo Step2: 啟用它就會轉到 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

uj5u.com熱心網友回復：

如果您在回圈中激活 else ，當然回圈將留在第一次迭代。您需要在回圈完成后檢查是否找到了作業表。
據我了解，您正在設定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）

uj5u.com熱心網友回復：

單元格中包含字串的參考作業表

• 您可以使用以下函式來參考找到的作業表：

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

• 請注意，該函式在作業簿中的最后一個作業表之后添加作業表。

標籤：擅长 vba if 语句

上一篇：MS-Access2016中的慢速INNERJOIN查詢，解決方法？

下一篇：根據單元格更改隱藏Excel列