使用Range.Find在不同的列中查找多個值

我正在尋找同時具有“Tuning Range”“Test-Config”的行的行索引，然后重復該程序，但找到具有“Tuning Range”“FunctionalTest”的行的行索引

到目前為止，這是我的代碼。當它運行它時，它適用于該行rowindex = getrowindex(sysnum, "Tuning Range", "Test-Config")，但隨后將下一行顯示為值為 0 rowindex_1 = getrowindex(sysnum, "Tuning Range", "FunctionalTest")。我還添加了訊息框Function getrowindex以查看它是否一直在運行，并且我無法讓我的第二個Set陳述句訊息框只出現第一個，因此看起來整個代碼部分沒有輸出任何內容。

Set parameter_row = Worksheets(WDnum).Range("C:C").Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Row value" & getrowindex
    Exit Function
    End If

Public Sub Main()
Dim wb As Workbook, ws As Worksheet, i As Range, dict As Object, sysrow As Integer, sysnum As String, wsName As String
Dim wbSrc As Workbook
Dim SDtab As Worksheet
Dim Value As Long, colindex As Long, rowindex As Long, rowindex_1 As Long

Set wb = ThisWorkbook
Set ws = wb.Worksheets("Sheet1") 

Set wbSrc = Workbooks.Open("Q:\QSpecification and Configuration Document.xlsx")
Set dict = CreateObject("scripting.dictionary")
    For Each i In ws.Range("E2:E15").Cells 
        sysnum = i.Value
        sysrow = i.Row
        syscol = i.Column

    If sysnum = "" Then
    End If
If Not dict.Exists(sysnum) Then ' check if unique value already exists before adding it to dictionary
    dict.Add sysnum, True
    If Not SheetExists(sysnum, ThisWorkbook) Then
        wsName = i.EntireRow.Columns("D").Value 
        If SheetExists(wsName, wbSrc) Then 
            wbSrc.Worksheets(wsName).Copy After:=ws 
            wb.Worksheets(wsName).name = sysnum 
        End If
        
 Sheets(1).Select
colindex = getcolumnindex(ws, "Tuning Range")
Value = getjiradata(ws, sysrow, colindex)

rowindex = getrowindex(sysnum, "Tuning Range", "Test-Config")
rowindex_1 = getrowindex(sysnum, "Tuning Range", "FunctionalTest")

    Else
        MsgBox "Sheet " & sysnum & " already exists"
    End If
End If

Next i
End Sub

Function SheetExists(SheetName As String, wb As Workbook)
    On Error Resume Next
    SheetExists = Not wb.Sheets(SheetName) Is Nothing
End Function

Function getcolumnindex(sht As Worksheet, colname As String) 
Dim paramname As Range
Set paramname = sht.Range("A1:Z2").Find(What:=colname, Lookat:=xlWhole, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=True)
    If Not paramname Is Nothing Then
        getcolumnindex = paramname.Column
    End If
End Function

Function getjiradata(sht As Worksheet, WDrow As Integer, parametercol As Long) 
    getjiradata = sht.Cells(WDrow, parametercol)
End Function

Function getrowindex(WDnum As Variant, parametername As String, routingname As String) As Long 
Dim parameter_row As Range

Set parameter_row = Worksheets(WDnum).Range("B:B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Parameter row value is " & getrowindex
Exit Function
    End If
Set parameter_row = Worksheets(WDnum).Range("C:C").Find(What:=routingname, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not parameter_row.EntireRow.Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True) Is Nothing Then
        getrowindex = parameter_row.Row
    MsgBox "Row value" & getrowindex
    Exit Function
    End If
End Function

uj5u.com熱心網友回復：

你可以這樣做：

'In sheet `WDNum`, find the row with `parametername` in ColB and `routingname` in ColC
'  return zero if not match found
Function getrowindex(WDnum As Variant, parametername As String, routingname As String) As Long
    Dim parameter_row As Range, ws As Worksheet, f As Range, addr As String
    
    Set ws = ThisWorkbook.Sheets(WDnum)
    
    Set f = ws.Columns("B").Find(What:=parametername, Lookat:=xlWhole, LookIn:=xlFormulas, MatchCase:=True)
    If Not f Is Nothing Then addr = f.Address 'remember the first cell found
    Do While Not f Is Nothing
        If f.Offset(0, 1).Value = routingname Then 'check col C value
            getrowindex = f.row
            Exit Function
        End If
        Set f = ws.Columns("B").FindNext(after:=f) 'find the next match
        If f.Address = addr Then Exit Do 'exit if we've looped back around
    Loop
End Function

標籤：擅长vba

上一篇：根據排名類別回傳字串值的公式

下一篇：Excel：選擇介于2個日期之間的日期