Question

我有两列（A列和B列）数据有很多噪音，我试图从中提取某些单词并使用VBA在下一列中打印这些单词。列如下（逗号分隔行）：

Column A: Blah, Blah, Y, Blah
Column B: Blah, %_Y, Blah

到目前为止

代码（来自评论）：

Sub try() 
    Dim lRow As Long
    Dim strSearch As String

    strSearch = "BHA"
    With Sheets("Sheet1") 
        .AutoFilterMode = False 
        lRow = .Range("A" & .Rows.Count).End(xlUp).Row 
        With .Range("A" & lRow)
            .AutoFilter Field:=1, Criteria1:="=*" & strSearch & "*"
            .Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        End With
        .AutoFilterMode = False
    End With 
End Sub

我想在连续找到“Y”时从两列中提取单词“Y”，我希望将它打印在C列的完全相同的行中。

Answer 1

这个简短的片段大部分取自您提供的片段，但替换了行删除，并在匹配的行中填充了C列中strSearch var的值。

Sub try_again()
    Dim strSearch As String, c As Long

    strSearch = "BHA"
    With Worksheets("Sheet4")
        .AutoFilterMode = False
        For c = 1 To 2
            With Intersect(.Columns(c), .UsedRange)
                .AutoFilter Field:=1, Criteria1:=Chr(42) & strSearch & Chr(42)
                With .Resize(.Rows.Count - 1, 1).Offset(1, 0)
                    If CBool(Application.Subtotal(103, .Cells)) Then
                        .Offset(0, 2 + (c > 1)) = strSearch
                    End If
                End With
                .AutoFilter
            End With
        Next c
        .AutoFilterMode = False
    End With
End Sub

原生工作表SUBTOTAL function用于检查可见行，因为其COUNTA sub-function不计算隐藏值。

Answer 2

这应该让你开始。它将在COL A中搜索关键字，然后在COL B中搜索关键字。如果在A或B中找到该单词，它将在同一行的COL C中打印该单词。

这是单一搜索字词

Sub ExtractKeyWordFromColAAndColB()

    Dim SearchedWord As String
    Dim NewString As String
    Dim LengthWord As Long
    Dim IndexStartWord As Long
    SearchedWord = "Y" 'The Key Word
    LengthWord = Len(SearchedWord) 'The Length of the key word

    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        NewString = "" 'Set to EMPTY with each iteration

        If InStr(UCase(Range("A" & i).Value), UCase(SearchedWord)) > 0 Then 'Look for Key word in Column A; Not Case sensitive
            IndexStartWord = WorksheetFunction.Find(UCase(SearchedWord), UCase(Range("A" & i).Value))
            NewString = Mid(Range("A" & i).Value, IndexStartWord, LengthWord)
        End If

         If InStr(UCase(Range("B" & i).Value), UCase(SearchedWord)) > 0 Then 'Look for Key word in Column B; Not Case sensitive
            IndexStartWord = WorksheetFunction.Find(UCase(SearchedWord), UCase(Range("B" & i).Value))
            NewString = NewString + " " + Mid(Range("B" & i).Value, IndexStartWord, LengthWord)
        End If

        Range("C" & i).Value = WorksheetFunction.Trim(NewString)


    Next i

End Sub

这是多个搜索字词

Sub ExtractKeyWordFromColAAndColB()

    Dim NewString As String
    Dim ColumnLetter As String
    Dim IndexStartWord As Long
    Dim SearchedWord(0 To 2) As String 'Key Words; You may add more to the list.
    'If you add more to the list update numbers above (i.e. SearchedWord(0 To 2))
    SearchedWord(0) = "X"
    SearchedWord(1) = "Y"
    SearchedWord(2) = "Z"

    For i = 1 To ActiveSheet.UsedRange.Rows.Count
        NewString = "" 'Set to EMPTY with each iteration

        For k = 1 To 2

            If k = 1 Then ColumnLetter = "A" Else ColumnLetter = "B"

            For j = 0 To UBound(SearchedWord) 'Look for Key words; Not Case sensitive
                If InStr(UCase(Range(ColumnLetter & i).Value), UCase(SearchedWord(j))) > 0 Then
                    IndexStartWord = WorksheetFunction.Find(UCase(SearchedWord(j)), UCase(Range(ColumnLetter & i).Value))
                    NewString = NewString + "-" + Mid(Range(ColumnLetter & i).Value, IndexStartWord, Len(SearchedWord(j)))
                End If
            Next j
        Next k

        Range("C" & i).Value = WorksheetFunction.Substitute(NewString, "-", "", 1)
    Next i

End Sub

从带有噪声的字符串中提取单词并将其打印在下一列中

2 个答案: