我有两列(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列的完全相同的行中。
答案 0 :(得分:0)
这个简短的片段大部分取自您提供的片段,但替换了行删除,并在匹配的行中填充了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不计算隐藏值。
答案 1 :(得分:0)
这应该让你开始。它将在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