使用VBA檢索特定列中同一行中單元格的值

Question

我當前正在處理一個隱含的語句，即如果工作表中名為“ Matrix”的“ G3：ED3”范圍內的任何單元格值都與“ H3：H204”范圍內的單元格值相匹配，名為“ Staff”的工作表，“矩陣”工作表中“ G5：ED57”范圍內的任何單元格值都是數字，然后與數字值相交的B列中的單元格值將檢索到所需的單元格地址在目標模板中。

到目前為止，這是我嘗試過的：

    Dim rng1 As Range
    Set rng1 = Worksheets("Matrix").Range("G3:ED3")
    Dim rng2 As Range
    Set rng2 = Worksheets("Staff").Range("H3:H204")
    Dim rng3 As Range
    Set rng3 = Worksheets("Matrix").Range("G5:ED57")

    For Each cell In Range(rng1, rng2, rng3)
    While IsNumeric(rng3) And rng1.Value = rng2.Value
    Worksheets("Matrix").Columns("B").Find(0).Row = 
    Worksheets("TEMPLATE_TARGET").Value(12, 4)
    Wend

我不確定如何定義該語句，因此代碼將自動檢索B列中該單元格的值，該列與rng3中包含數值的任何單元格相交。 任何建議將不勝感激。

Answer 1

最好是適當地閱讀文檔/正在使用的學習資源，因為您似乎已經誤解了While工作原理（以及其他一些事情）

While本身是一個循環，但它並不充當For循環的Exit條件。

---

綜上所述，從您的問題中也不清楚要實現的目標。

我的假設是，您要檢查所有條件，然后如果它們匹配，則希望將結果粘貼到“ TEMPLATE ”表中

首先，我們為兩個數據范圍中的值創建一個函數theck：

Private Function IsInColumn(ByVal value As Variant, ByVal inSheet As String) As Boolean
Dim searchrange As Range

On Error Resume Next ' disables error checking (Subscript out of range if sheet not found)

    ' the range we search in
    If Trim(LCase(inSheet)) = "matrix" Then
        Set searchrange = Sheets("Matrix").Range("G5:ED7")
    ElseIf Trim(LCase(inSheet)) = "staff" Then
        Set searchrange = Sheets("Staff").Range("H3:H204")
    Else
        MsgBox ("Sheet: " & inSheet & " was not found")
        Exit Function
    End If

On Error GoTo 0 ' re-enable error checking

    Dim result As Range
    Set result = searchrange.Find(What:=value, LookIn:=xlValues, LookAt:=xlWhole)
    ' Find returns the find to a Range called result

    If result Is Nothing Then
        IsInColumn = False ' if not found is search range, return false

    Else
        If IsNumeric(result) Then ' check for number
            IsInColumn = True ' ding ding ding, match was found
        Else
            IsInColumn = False ' if it's not a number
        End If
    End If

End Function

然后，我們運行搜索過程。

Private Sub check_in_column()

    Dim looprange As Range: Set looprange = Sheets("Matrix").Range("G3:ED3")
    Dim last_row As Long

    For Each cell In looprange ' loops through all the cells in looprange
        'utlizes our created IsInColumn function
        If IsInColumn(cell.Value2, "Matrix") = True And _
           IsInColumn(cell.Value2, "Staff") = True Then
             ' finds last actively used row in TEMPLATE_TARGET
            last_row = Sheets("TEMPLATE_TARGET").Cells(Rows.Count, "A").End(xlUp).Row
            ' pastes the found value
            Sheets("TEMPLATE_TARGET").Cells(last_row, "A") = cell.Value2
        End If

    ' otherwise go to next cell
    Next cell

End Sub

---

由於實用程序的原因，我在示例中重新定義了您的范圍，但它按預期工作

在我的Matrix表中：（ 工作人員工作表僅包含此表的副本）

運行該過程后，在我的TEMPLATE_TARGET表中。

預期結果

Answer 2

如果我很好理解，我會做這樣的事情：

Option Explicit

Public Sub Main()

    Dim wsMatrix As Worksheet: Set wsMatrix = ThisWorkbook.Worksheets("Matrix")
    Dim rgMatrix As Range: Set rgMatrix = wsMatrix.Range("G3:ED3")

    Dim cell As Range
    Dim cellStaff As Range
    Dim cellMatrix As Range

    For Each cell In rgMatrix
        If CheckRangeStaff(cell.Range) And CheckRangeMatrix() Then
             'Process in a column B? Which sheet? Which cell? Which Process?
        End If
    Next cell

    Debug.Print ("End program.")

End Sub

Public Function CheckRangeStaff(ByVal value As String) As Boolean

    Dim wsStaff As Worksheet: Set wsStaff = ThisWorkbook.Worksheets("Staff")
    Dim rgStaff As Range: Set rgStaff = wsStaff.Range("H3:H204")
    Dim res As Boolean
    Dim cell As Range

    res = False

    For Each cell In rgStaff
         If cell.value = value Then
             res = True
             Exit For
         End If
    Next cell

    CheckRangeStaff = res

End Function

Public Function CheckRangeMatrix() As Boolean

    Dim wsMatrix As Worksheet: Set wsMatrix = ThisWorkbook.Worksheets("Matrix")
    Dim rgMatrix As Range: Set rgMatrix = wsMatrix.Range("G5:ED57")
    Dim res As Boolean
    Dim cell As Range

    res = False

    For Each cell In rgMatrix
         If IsNumeric(cell.value) Then
             res = True
             Exit For
         End If
    Next cell

    CheckRangeMatrix = res

End Function