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

Question

我目前正在处理的语句意味着，如果工作表中名为"Matrix“的工作表中"G3:ED3”范围内的任何单元格值与"Staff“工作表中”H3:H 204“范围内的单元格值和”矩阵“工作表中"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“表中

首先，我们为两个数据范围中的值创建一个函数the：

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