VBA代码可在其旁边查找值复制值并粘贴到其他单元格中

Question

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

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

现在，由于单词“ Title_product”旁边有多个标题，因此，我希望每次在C列中找到标题时，都会在其结果中添加“ AND”。例如：在A列上，我们有2行带有单词“ Title_product”，C列上的书名是Book 1和Book2。我希望单元格A10中的值为：“ Book 1和Book 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

我通过迭代A列而不是使用Find来解决此问题。需要注意的一件事是，如果您正在搜索A列，并且还将输出打印到A列中，则可能是一个问题：我会考虑在其他位置打印输出（例如，将outputCell更改为其他位置）。

Sub FindingValues()
Dim valStr As String, found() As String, outputStr As String
Dim outputCell As Range
Dim ws As Worksheet
Dim x As Long, foundCt As Long, lastRow As Long

'define the sheet to be worked on
Set ws = ActiveWorkbook.ActiveSheet

'define the output cell
Set outputCell = ws.Cells(10, 1) 'A10

'define the text to search for
valStr = "Title_product"

'find last row to use
lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

'change the array size to match the number of possible results
ReDim found(lastRow) As String

'loop through all cells in column A
For x = 1 To lastRow

    'check cells in column A for valStr
    If InStr(LCase(ws.Cells(x, 1).Text), LCase(valStr)) Then

        'if found, store found values in array
        foundCt = foundCt + 1
        found(foundCt) = ws.Cells(x, 3).Text

    End If

Next x

'format the output based on the number of found items
'(Book 1 | Book 1 and Book 2 | Book 1, Book 2, and Book 3)

'if no results were found
If found(1) = "" Then
    outputStr = "..."

'if one result was found
ElseIf found(1) <> "" And found(2) = "" Then
    outputStr = found(1)

'if two results were found
ElseIf found(1) <> "" And found(2) <> "" And found(3) = "" Then
    outputStr = found(1) & " and " & found(2)

'if three or more results were found
Else
    outputStr = found(1)
    For x = 2 To foundCt - 1
        outputStr = outputStr & ", " & found(x)
    Next x
    outputStr = outputStr & ", and " & found(foundCt)
End If

'print the output to the output cell
outputCell.Formula = outputStr

End Sub

Answer 2

您可能不小心删除了firstAddress行-String只是长度为零的result。

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

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

样品数据