创buildmacros以查找范围内的文本string并从匹配的行中返回数据

早上好,我正在构build一个macros,它将从名为Committees的单元格A2表中find一个名为Database的范围为P2:CP5000的特定文本,并从包含所有行的列中返回列A:O的数据这个文本string,并打印出来,从报表上的单元格F2开始。 这是我根据一些build议所做的。 但是,它不返回期望的值,它将数据库中A列的数据复制到报表中的F:T。 另外我认为循环不工作,因为它不会停止在范围r1的最后一行之后。

Sub Macro1() Dim r1 As Range, r2 As Range, r3 As Range Dim rw1 As Long Dim tmpRow As Long tmpRow = 2 Set r2 = Sheets("Committees").Range("A2") Set r1 = Sheets("Database").Range("P2:CO5000") Set r3 = ThisWorkbook.Sheets("Reports").Range("F2:T2") rw1 = 0 rw1 = r1.Find(What:=r2.Value, After:=r1(1)).Row Do While rw1 <> 0 r3.Value = Sheets("Database").Range("A" & rw1 & ":O" & rw1).Value tmpRow = tmpRow + 1 Set r3 = ThisWorkbook.Sheets("Reports").Range("F" & tmpRow & ":T" & tmpRow) rw1 = 0 rw1 = r1.FindNext().Row Loop End Sub 

提前致谢!

最终编辑:

我忘了检查是否已经find特定的单元格(现在使用FirstAddress)。 无限循环是由于代码一遍又一遍地find相同的条目。

我testing了下面的代码,它适用于我。

 Sub joseph() Dim awb As Workbook Dim cm, db, rp As Worksheet 'committees, database, reports Dim tmpRng As Range Dim firstAddress As String Dim tmpRow As Integer Dim r As Integer Dim searchValue As String Set awb = ThisWorkbook With awb Set cm = .Worksheets("Committees") Set db = .Worksheets("Database") Set rp = .Worksheets("Reports") End With searchValue = cm.Range("A2").Value tmpRow = 0 r = 2 With db Set tmpRng = .Range("P2:CP5000").Find(searchValue, _ LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext, MatchCase:=False) If Not tmpRng Is Nothing Then firstAddress = tmpRng.Address Do tmpRow = tmpRng.Row rp.Range("F" & r & ":T" & r).Value = .Range("A" & tmpRow & ":O" & tmpRow).Value r = r + 1 Set tmpRng = .Range("P2:CP5000").FindNext(tmpRng) Loop While Not tmpRng Is Nothing And tmpRng.Address <> firstAddress End If End With End Sub 

最初的回复和编辑:

尝试改变这一行

 Set rw1 = .FindNext(rw1) 

 rw1 = r1.FindNext().Row 

rw1不是一个范围,因此types不匹配。 让我知道这个是否奏效。

编辑 :也改变这一行:

 If Not rw1 Is Nothing Then 

 if rw1 <> 0 then 

并添加这一行

 rw1 = 0 

在这行之前:

 rw1 = r1.Find(What:=r2.Value, After:=r1(1)).Row 

编辑2:关于for循环和更新r3如果文本string存在多次,你必须保持for循环,你可以通过声明一个行variables来更新r3范围,例如

 Dim tmpRow = 2 as integer 

然后在rw1 = 0之前写入for循环

 tmpRow = tmpRow + 1 set r3 = thisWorkbook.Sheets("Reports").Range("F" & tmprow & ":T" & tmprow)