使用VBA检索特定列中同一行中单元格的值

Question

我目前正在研究的语句暗示，如果名为“Matrix”的工作表中“G3:ED3”范围内的任何单元格值与“H3:H204”范围内的单元格值匹配”在名为“Staff”的工作表中，并且“Matrix”工作表中“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”表

首先我们为两个数据范围内的值创建一个检查函数：

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