使用VBA代码

Question

我正在处理大型excel文件，我需要一种使用VBA代码自动完成工作的方法，以下是我的工作和需要的简要说明：

我有一个包含标题的列，我手动搜索某个值，然后我将值写入另一列，然后我搜索另一个值并重复相同的步骤，如果我找到2个值然后我写它在逗号分隔的同一个单元格中，

我需要的是一个脚本，它在值表中查找第一个值并在Title列中搜索它并检索相邻列中的值，然后对表中的每个值重复此步骤。

见下面的例子：

表1：包含要搜索的值

Values
VBA
Excel
Data
Format
Sum
Replace

表2：含有标题

Title
Excel VBA Code to find and Replace
VBA/ Excel determine if cell has a data validation error with vba code
Excel VBA - Finding a relative range of data
Excel VBA code to negate values

结果将是找到的值，如下图所示：

我希望这很清楚，我需要它尽可能动态。 我感谢任何帮助 谢谢

Answer 1

这应该适合你。

Sub Keyword()
    Dim Words As Range
    Dim strText As Range
    Dim c As Range
    Dim r As Range
    Application.ScreenUpdating = False
    Set Words = Range("A2").Resize(Range("A" & Rows.Count).End(xlUp).Row - 1)  '-->change "A" here to your Value column
    Set strText = Range("C2").Resize(Range("C" & Rows.Count).End(xlUp).Row - 1)  '-->change "C" here to your Title column
    For Each c In strText
        For Each r In Words
            If InStr(1, UCase(c), UCase(r), 1) > 0 Then
                c.Offset(, 1) = c.Offset(, 1) & ", " & r
            End If
        Next r
        If Len(c.Offset(, 1)) > 0 Then c.Offset(, 1) = Right(c.Offset(, 1), (Len(c.Offset(, 1)) - 2))
    Next c
    Application.ScreenUpdating = True
End Sub

这将为您提供如下输出：

如果您想将此代码用作函数，请尝试以下操作：

Function Keywords(Words As Range, strText As Range)
    Dim c As Range
    For Each c In Words
    If InStr(1, strText, c, 1) > 0 Then Keywords = Keywords & ", " & c
        Next c
        If Keywords = 0 Then
        Keywords = "-"
    Else
        Keywords = Right(Keywords, Len(Keywords) - 2)
    End If
End Function

来自here。