VBA代码查找旁边的值复制值并粘贴到不同的单元格中

Question

我是 VBA 编码的新手，我正在寻找一种方法来找到 A 列中的特定文本，然后复制它旁边的下一个可用单词(C 列)并将其粘贴到同一个工作表内的 A10 单元格中。

我在 Stack Overflow 上找到了一个代码，它在 A 列上找到了我要查找的单词，它告诉我 C 列上的下一个值是什么，但我无法将其粘贴到单元格 A10 上。

现在，由于单词旁边有多个标题:“Title_product”，我希望每次在 C 列上找到标题时，它都会在其查找结果中添加一个“AND”。例如:在 A 列上，我们有 2 行包含单词“Title_product”，C 列上的书名是书 1 和书 2。我希望单元格 A10 中的值为:“书 1 和书 2”如果这太多了，不用担心，如果它可以将 C 列中的标题粘贴到工作表内的某个位置，那么我可以使用 Excel 公式。

This is the code that I was trying to modify:
Public Sub FindingValues()
Dim val As Variant
val = "Title_product"
Set c = Cells.Find(val, LookIn:=xlValues, MatchCase:=False)
If Not c Is Nothing Then
    Do
        MsgBox "Value of val is found at " & c.Address & vbCrLf & c.Offset(0, 1).Value & vbCrLf & c.Offset(0, 2).Value
        Set c = Cells.FindNext(c)
    Loop While Not c Is Nothing And c.Address <> firstaddress
End If
End Sub

太感谢了!

Answer 1

您可能不小心删除了 firstAddress = c.Address 行- 原样，firstAddress只是一个零长度 String .

除此之外，添加 result当在 A 列中找到“Title_Product”时，将 C 列中的值连接在一起的变量。然后写 result至Range("A10")循环之后。

Public Sub FindingValues()
    Dim val As String, result As String, firstAddress As String
    Dim c As Range

    val = "Title_product"
    Set c = Sheets("MySheetName").Range("A:A").Find(val, LookIn:=xlValues, MatchCase:=False)

    If Not c Is Nothing Then
        firstAddress = c.Address

        Do
            If Len(result) > 0 Then
                result = result & " and " & c.Offset(, 2).Text
            Else
                result = c.Offset(, 2).Text
            End If

            Set c = Cells.FindNext(c)
        Loop While Not c Is Nothing And c.Address <> firstAddress
    End If

    Sheets("MySheetName").Range("A10").Value = result
End Sub

样本数据