如果行包含单词"Hello"则将该列中的所有填充单元格复制到另一张工作表中，然后将其粘贴到列"A"

Question

我正在尝试创建一个宏，该宏将在变量行的工作表 nr.1 中查找单词"Hello"。一旦检测到，它应该复制该单词下的所有填充单元格，并将其粘贴到"B"列下的工作表 nr.2 中。
我在这里有几个问题，如何找到包含此单词的单元格并复制此地址下的所有填充单元格并将它们粘贴到B列下的另一张工作表中。

如果有人能给我一些这种练习的例子，我将不胜感激。

---

With Sheets("GCC1")
lastrowGCC1 = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
End With
arr1 = Array("K", "P", "Q", "AA")
arr2 = Array("A", "D", "E", "O")
For i = LBound(arr1) To UBound(arr1)
With Sheets("Project Parts Requisitioning")
lastrow = Application.Max(n, .Cells(.Rows.Count, arr1(i)).End(xlUp).Row)
.Range(.Cells(n, arr1(i)), .Cells(lastrow, arr1(i))).Copy
Sheets("GCC1").Range(arr2(i) & lastrowGCC1).PasteSpecial xlPasteValues
End With
Next
Application.CutCopyMode = False

Answer 1

Sub Demo()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long
Dim rng As Range, rng2 As Range
Dim cellFound As Range
Set ws1 = ThisWorkbook.Sheets(1)  'change to "GCC1" or use number index
Set ws2 = ThisWorkbook.Sheets(2)
Set rng = ws1.Range("A:A") 'range to search
lastrowGCC1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
Set rng2 = rng(lastrowGCC1, 1)
i = 1
With rng
Set cellFound = .Find(what:="Hello", After:=rng2, LookIn:=xlValues)
If Not cellFound Is Nothing Then
FirstAddress = cellFound.Address
Do
ws2.Cells(i, 2) = ws1.Range(cellFound.Address).Value
ws2.Cells(i, 3) = cellFound.Address
i = i + 1
Set cellFound = .FindNext(cellFound)
Loop While Not cellFound Is Nothing And cellFound.Address <> FirstAddress
End If
End With
End Sub

此函数从工作表 1 中写有"Hello"的"A"列中查找所有单元格地址，然后在工作表 2 的"B"列和"C"列上写入地址。

在工作表(1(中，您有：

+---+-------+
|   |   A   |
+---+-------+
| 1 | Hello |
| 2 | Hello |
| 3 | Hello |
| 4 |       |
| 5 |       |
| 6 |       |
| 7 |       |
| 8 |       |
| 9 | Hello |
+---+-------+

工作表(2(上的输出是：

+---+-------+------+
|   |   B   |  C   |
+---+-------+------+
| 1 | Hello | $A$1 |
| 2 | Hello | $A$2 |
| 3 | Hello | $A$3 |
| 4 | Hello | $A$9 |
+---+-------+------+

ps.：如果你的范围太大，请考虑使用字典的匹配方法，例如：在VBA中使用scripting.dictionary优化比较和匹配方法