VBA：如何搜索单元格范围的值，并返回该位置旁边的单元格？
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了VBA：如何搜索单元格范围的值，并返回该位置旁边的单元格？相关的知识，希望对你有一定的参考价值。
大家好，这是我的第一个问题，所以我会尽力做到最好。
下面没有特定单元名称的快速描述
我正在尝试编写一个宏，其中用户输入值（X）并且宏搜索一系列单元格中的值（X），然后宏返回值位置旁边的3个空格中的单元格值（X）是。
有些事情使得这个无法解决的事实是用户在Sheet1上输入值并且值被公式移动到Sheet2，我似乎无法弄清楚如何使用Find我在哪里查找值for尚未在宏中定义。
使这个困难的另一件事是，范围也不是严格可定义的，因为列表可能比现在更长或更短，我不知道它何时会改变。因此，搜索范围必须根据用户输入的List开始，并且需要一直到达空白点。
例如：Range。（“C7：D10”）不起作用，因为用户可以输入更改工作范围的新信息，如下所述。
以下是进一步说明的屏幕截图
https://i.stack.imgur.com/wlnhg.jpg
因此，在此屏幕截图中，单元格C3和D3是Sheet1中的导入值。
C3是（= Sheet1！B2）
D3是（= Sheet1！B3）
我们的想法是宏运行并向下搜索A列，直到它与C3匹配。
然后搜索功能移动两个单元格并向下搜索直到它与D3匹配或直到它到达空白区域。
我不知道如何根据导入的值要求宏搜索，我不知道如何要求它搜索我需要的这个奇怪的特定范围。我的想法是，我的工作中的某个人可以来并在C10下面添加一行并添加必要的信息，宏仍然可以工作并搜索到C11，然后告诉宏停止后会有一个空格。
在搜索找到D3的匹配之后，它将匹配的值返回到顶部的相应单元格E3，F3和G3。
我希望这个问题以人们可以理解的方式被问到，我很累，所以不知道我是否写了一些有意义的东西。感谢您阅读我的帖子，你们都是最棒的！
答案
Search Twice
Workbook Download（Dropbox）
Sub SearchTwice()
Const cSheet As String = "Sheet2" ' Source Worksheet Name
Const cList As String = "C3" ' List Cell Range Address
Const cName As String = "D3" ' Name Cell Range Address
Const cListCol As String = "A" ' List Column Letter
Const cNameCol As String = "C" ' Name Column Letter
Const cFirst As Long = 6 ' First Row
Const cCol As Long = 3 ' Number of Columns
Dim rng1 As Range ' Find List Cell Range
' Found Name Cell Range
Dim rng2 As Range ' Next List Cell Range
' Name Search Range
Dim strList As String ' List
Dim strName As String ' Name
' In Source Worksheet
With ThisWorkbook.Worksheets(cSheet)
' Write from List Cell Range to List.
strList = .Range(cList)
' Write from Name Cell Range to Name.
strName = .Range(cName)
' Check if Cell Ranges do NOT contain data.
If strList = "" Or strName = "" Then ' Inform user.
MsgBox "Missing List or Name.", vbCritical, "Missing data"
Exit Sub
End If
' In List Column
With .Columns(cListCol)
' Create a reference to Find List Cell Range (rng1) containing
' List (strList).
Set rng1 = .Find(strList, .Cells(cFirst - 1), xlValues, xlWhole)
' Check if List has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The list '" & strList & "' has not been found", _
vbCritical, "List not found"
Exit Sub
End If
' Create a reference to Next List Cell Range (rng2).
Set rng2 = .Find("*", .Cells(rng1.Row), xlValues, xlWhole)
End With
' In Name Column
With .Columns(cNameCol)
' Check if the row of Next List Cell Range (rng2) is greater than
' the row of List Cell Range (rng1) i.e. if a cell with a value
' has been found below List Cell Range (rng1) in List Column.
If rng2.Row > rng1.Row Then ' Next List Cell Range FOUND.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the cell
' above the Next List Cell Range (rng2), but in Name Column.
Set rng2 = .Cells(rng1.Row + 1).Resize(rng2.Row - rng1.Row - 1)
Else ' Next List Cell Range NOT found.
' Create a reference to Name Search Range (rng2) which spans
' from the cell below Find List Cell Range (rng1) to the bottom
' cell, but in Name column.
Set rng2 = .Cells(rng1.Row + 1).Resize(.Rows.Count - rng1.Row)
End If
End With
' In Name Search Range (rng2)
With rng2
' Create a reference to Found Name Cell Range (rng1).
Set rng1 = .Find(strName, .Cells(.Rows.Count), xlValues, xlWhole)
End With
' Check if Name has not been found.
If rng1 Is Nothing Then ' Inform user and exit.
MsgBox "The name '" & strName & "' has not been found", _
vbCritical, "Name not found"
Exit Sub
End If
' Remarks:
' Source Range is calculated by moving the Found Name Cell Range (rng1)
' one cell to the right and by resizing it by Number of Columns (cCol).
' Target Range is calculated by moving the Name Cell Range one cell
' to the right and by resizing it by Number of Columns (cCol).
' Copy values of Source Range to Target Range.
.Range(cName).Offset(, 1).Resize(, cCol) _
= rng1.Offset(, 1).Resize(, cCol).Value
End With
' Inform user of succes of the operation.
MsgBox "The name '" & strName & "' was successfully found in list '" & _
strList & "'. The corresponding data has been written to the " _
& "worksheet.", vbInformation, "Success"
End Sub
另一答案
疲倦的一个原因是你在准备屠宰之前试图去杀人。下面的解决方案花了一个小时准备和10分钟编码。将整个代码粘贴到标准代码模块中，并从立即窗口（MatchRow）或您自己的代码调用函数? MatchRow，如下面的测试过程中所示。
Option Explicit
Enum Nws ' worksheet navigation
' 01 Mar 2019
NwsCriteriaRow = 3
NwsList = 1 ' Columns: (1 = A)
NwsID = 3
NwsNumber ' (undefined: assigns next integer)
End Enum
Function MatchRow() As Long
' 01 Mar 2019
' return 0 if not found
Dim Ws As Worksheet
Dim Rng As Range
Dim R As Long
' The ActiveWorkbook isn't necessarily ThisWorkbook
Set Ws = ActiveWorkbook.Worksheets("Sheet2") ' replace tab's name here
With Ws
Set Rng = .Range(.Cells(NwsCriteriaRow, NwsList), .Cells(.Rows.Count, NwsList).End(xlUp))
R = FindRow(.Cells(NwsCriteriaRow, NwsID).Value, Rng, True)
If R Then ' skip if no match was found
Set Rng = .Cells(R + 1, NwsID)
Set Rng = .Range(Rng, Rng.End(xlDown))
MatchRow = FindRow(.Cells(NwsCriteriaRow, NwsNumber).Value, Rng)
End If
End With
End Function
Private Function FindRow(Crit As Variant, _
Rng As Range, _
Optional ByVal SearchFromTop As Boolean) As Long
' 01 Mar 2019
' return 0 if not found
Dim Fun As Range
Dim StartCell As Long
With Rng
If SearchFromTop Then
StartCell = 1
Else
StartCell = .Cells.Count
End If
Set Fun = .Find(What:=Crit, _
After:=.Cells(StartCell), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
MatchCase:=False)
End With
If Not Fun Is Nothing Then FindRow = Fun.Row
End Function
函数MatchRow返回找到D3的Sheet2的行号，仅搜索属于C3中标识的列表的列D的那一部分。如果未找到匹配项，则该函数返回0，无论是列表还是ID。
您没有指定要对找到的行执行的操作。以下过程将返回该行的数据。您可以使用该功能来寻址要写入的单元格。
Private Sub RetrieveData()
Dim R As Long
R = MatchRow
MsgBox "ID = " & Cells(R, NwsID).Value & vbCr & _
"Number = " & Cells(R, NwsNumber).Value
End Sub
仅用于测试上述过程不会指定工作表，因此返回ActiveSheet中的数据，假定为Sheet2。
另一答案
VBA解决方案
我认为非VBA解决方案在这里是理想的，但为了以防万一，我将把它留在这里。假设表中没有值为空，这应该适用于您的情况。
Sub Test()
Dim ws As Worksheet: Set Worksheet = ThisWorkbook.Sheets("Sheet2")
Dim iList As Range, iName As Range
Dim aLR As Long, cLR As Long
aLR = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
Set iList = ws.Range("A1:A" & aLR).Find(ws.Range("C3"), LookIn:=xlWhole)
If Not iList Is Nothing Then
cLR = iList.Offset(0, 2).End(xlDown).Row
Set iName = ws.Range(ws.Cells(iList.Row, 3), ws.Cells(cLR, 3)).Find(ws.Range("C4"), LookIn:=xlWhole)
If Not iName Is Nothing Then
ws.Range("E3:G3").Value = iName.Offset(0, 1).Resize(1, 3).Value
End If
End If
End Sub
另一答案
不是VBA解决方案
- 将两个列表范围转换为表格
- 通过（
Formulas Tab > Name Manager > S以上是关于VBA：如何搜索单元格范围的值，并返回该位置旁边的单元格？的主要内容，如果未能解决你的问题，请参考以下文章