Excel 查找函数从包含句子的活动单元格中查找整个单词,而不是单个字符
Excel find function to find whole words from an active cell containing sentences, and not individual characters
附件是我到目前为止的代码。我的问题是,我似乎无法让宏仅将整个单词 sheet(2) B 列活动单元格(单元格中包含多个单词)与 [= 中的范围(A 列)进行比较38=](1) - 这是一个完整单词的列表(如下图所示)。代码中的其他所有内容都可以正常工作,但目前它仅适用于完全匹配?
我尝试过使用通配符方法,但它似乎可以匹配任何字符,而我需要它来比较句子中的整个单词(在活动单元格中每次都不同)。
关于我可以添加什么以便 countif 函数找到整个单词而不是字符等的任何提示? Find 函数也存在同样的问题,它只会找到完全匹配项,如果找不到完全匹配项,则会出现 return 错误。
Sub FMEATest1()
Dim count As Integer
Dim count2 As Integer
Dim n As Integer
Dim m As Integer
Dim FML As Range
Dim i As Range
'Dim m As Integer
Dim a As Range
Dim b As Integer
Dim FML2 As Range
Dim WrdArray() As String
Dim k As Range
Dim j As Range
Dim Splitsentence As Range
Worksheets(1).Activate
Range(("A1"), Range("A1").End(xlDown)).Select
Set FML = Selection
Worksheets(2).Activate
Range("B3").Activate
Do Until ActiveCell.value = ""
Set i = ActiveCell
WrdArray() = Split(i, , , vbTextCompare)
Set Splitsentence = WrdArray().value
count = Application.WorksheetFunction.CountIf(FML, Splitsentence)
'm = (ActiveCell.Row) + count - 1
n = Selection.Rows.count
Do Until n = (count)
ActiveCell.Offset(1, 0).EntireRow.Insert
Set a = Selection.Offset(1, 0)
ActiveCell.COPY
ActiveCell.Offset(1, 0).value = ActiveCell.value
ActiveCell.PasteSpecial
Range(i, a).Select
n = Selection.Rows.count
Loop
'Copying Failure Modes for each Keyword
Lookfor = ActiveCell.value & "*"
Worksheets(1).Activate
Cells.Find(What:=Lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Select
Set FML2 = Selection
Set j = ActiveCell
count2 = Application.WorksheetFunction.CountIf(FML2, j)
m = Selection.Rows.count
Do Until m = (count)
Set k = Selection.Offset(1, 0)
Range(j, k).Select
m = Selection.Rows.count
Loop
Selection.Offset(0, 1).COPY
Worksheets(2).Activate
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(n, -1).Activate
Loop
End Sub
困难在于activecell包含一个句子,这个句子每次都不同,如下例所示,但我需要宏来匹配sheet(2)中B列的整个关键字到Column sheet 中的 A (1)。
有人可以公开我的图片吗?
所以我会寻找能够从整个句子的单元格 B3 中找到单词 "charge" 的代码(并在 sheet 的 A 列中找到它( 1)).以及整个句子中 B4 中的单词 "Hold"。这些可能会发生很大变化,所以我无法手动将它们输入到我需要引用 activecell 的查找函数中。
代码的最终解决方案应给出以下结果(我已经为 "charge" 和 "hold" 给出了两个示例):
我假设了评论中概述的数据,因此您可能需要修改 sheet 名称和范围。此外,根据您 sheet 中的其他数据,它可能需要对输出进行一些调整,但如果您根据屏幕截图模拟一个示例,它应该可以按预期工作。
Sub x()
Dim v, vOut(), i As Long, j As Long, k As Long, va, r As Range, r1 As Long
'Assumes list of words in A1/B1 and down on "Sheet1"
Set r =Sheets("Sheet1").Range("A1").CurrentRegion
With Sheets("Sheet2") 'Assumes phrases in B1 and down on "Sheet2"
v = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value
.Columns(2).ClearContents
End With
ReDim vOut(1 To UBound(v) * r.Rows.Count, 1 To 2)
For i = LBound(v, 1) To UBound(v, 1)
va = Split(v(i, 1))
For j = LBound(va) To UBound(va)
For r1 = 1 To r.Rows.Count
If LCase(Application.Trim(va(j))) = LCase(r.Cells(r1, 1)) Then
k = k + 1
vOut(k, 1) = v(i, 1)
vOut(k, 2) = r.Cells(r1, 2)
End If
Next r1
Next j
Next i
Sheets("Sheet2").Range("B1").Resize(k, 2) = vOut 'Puts results in B1/C1 and down on "Sheet2"
End Sub
附件是我到目前为止的代码。我的问题是,我似乎无法让宏仅将整个单词 sheet(2) B 列活动单元格(单元格中包含多个单词)与 [= 中的范围(A 列)进行比较38=](1) - 这是一个完整单词的列表(如下图所示)。代码中的其他所有内容都可以正常工作,但目前它仅适用于完全匹配?
我尝试过使用通配符方法,但它似乎可以匹配任何字符,而我需要它来比较句子中的整个单词(在活动单元格中每次都不同)。
关于我可以添加什么以便 countif 函数找到整个单词而不是字符等的任何提示? Find 函数也存在同样的问题,它只会找到完全匹配项,如果找不到完全匹配项,则会出现 return 错误。
Sub FMEATest1()
Dim count As Integer
Dim count2 As Integer
Dim n As Integer
Dim m As Integer
Dim FML As Range
Dim i As Range
'Dim m As Integer
Dim a As Range
Dim b As Integer
Dim FML2 As Range
Dim WrdArray() As String
Dim k As Range
Dim j As Range
Dim Splitsentence As Range
Worksheets(1).Activate
Range(("A1"), Range("A1").End(xlDown)).Select
Set FML = Selection
Worksheets(2).Activate
Range("B3").Activate
Do Until ActiveCell.value = ""
Set i = ActiveCell
WrdArray() = Split(i, , , vbTextCompare)
Set Splitsentence = WrdArray().value
count = Application.WorksheetFunction.CountIf(FML, Splitsentence)
'm = (ActiveCell.Row) + count - 1
n = Selection.Rows.count
Do Until n = (count)
ActiveCell.Offset(1, 0).EntireRow.Insert
Set a = Selection.Offset(1, 0)
ActiveCell.COPY
ActiveCell.Offset(1, 0).value = ActiveCell.value
ActiveCell.PasteSpecial
Range(i, a).Select
n = Selection.Rows.count
Loop
'Copying Failure Modes for each Keyword
Lookfor = ActiveCell.value & "*"
Worksheets(1).Activate
Cells.Find(What:=Lookfor, After:=ActiveCell, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False).Select
Set FML2 = Selection
Set j = ActiveCell
count2 = Application.WorksheetFunction.CountIf(FML2, j)
m = Selection.Rows.count
Do Until m = (count)
Set k = Selection.Offset(1, 0)
Range(j, k).Select
m = Selection.Rows.count
Loop
Selection.Offset(0, 1).COPY
Worksheets(2).Activate
ActiveCell.Offset(0, 1).PasteSpecial
ActiveCell.Offset(n, -1).Activate
Loop
End Sub
困难在于activecell包含一个句子,这个句子每次都不同,如下例所示,但我需要宏来匹配sheet(2)中B列的整个关键字到Column sheet 中的 A (1)。
有人可以公开我的图片吗?
所以我会寻找能够从整个句子的单元格 B3 中找到单词 "charge" 的代码(并在 sheet 的 A 列中找到它( 1)).以及整个句子中 B4 中的单词 "Hold"。这些可能会发生很大变化,所以我无法手动将它们输入到我需要引用 activecell 的查找函数中。
代码的最终解决方案应给出以下结果(我已经为 "charge" 和 "hold" 给出了两个示例):
我假设了评论中概述的数据,因此您可能需要修改 sheet 名称和范围。此外,根据您 sheet 中的其他数据,它可能需要对输出进行一些调整,但如果您根据屏幕截图模拟一个示例,它应该可以按预期工作。
Sub x()
Dim v, vOut(), i As Long, j As Long, k As Long, va, r As Range, r1 As Long
'Assumes list of words in A1/B1 and down on "Sheet1"
Set r =Sheets("Sheet1").Range("A1").CurrentRegion
With Sheets("Sheet2") 'Assumes phrases in B1 and down on "Sheet2"
v = .Range("B1", .Range("B" & Rows.Count).End(xlUp)).Value
.Columns(2).ClearContents
End With
ReDim vOut(1 To UBound(v) * r.Rows.Count, 1 To 2)
For i = LBound(v, 1) To UBound(v, 1)
va = Split(v(i, 1))
For j = LBound(va) To UBound(va)
For r1 = 1 To r.Rows.Count
If LCase(Application.Trim(va(j))) = LCase(r.Cells(r1, 1)) Then
k = k + 1
vOut(k, 1) = v(i, 1)
vOut(k, 2) = r.Cells(r1, 2)
End If
Next r1
Next j
Next i
Sheets("Sheet2").Range("B1").Resize(k, 2) = vOut 'Puts results in B1/C1 and down on "Sheet2"
End Sub