现有代码中的修改用于在两张纸中搜索并省略短语中的单词

时间:2015-03-15 20:42:18

标签: excel vba

我有3张纸:

  • Sheet1包含B列中的短语(示例 - ABD Ron Tim 001)
  • Sheet2包含A列(示例Ron,Tim,Goerge)和
  • 中的单词列表
  • 第3页再次在A栏中包含短语(例1 - ABC Tim-001),(例2 - THER Goerge-898)。

下面的代码找到了表2列A列B列表1中的单词,如果匹配单词在phare中找到,则它会移动并匹配找到的单词与Sheet 3列A中的整个短语列匹配省略从输出中找到的单词。

输出显示在相邻单元格的第1列C列中。

此代码的问题在于,如果在表单3中,短语中的单词类似于tim-001,则会忽略它,但是如果单词与tim 001完全匹配,我想省略tim Option Explicit Sub Exec() Dim i As Long Dim iRow As Long Dim j As Long Dim Ws1 As Worksheet Dim Ws2 As Worksheet Dim Ws3 As Worksheet Dim IsFound As Boolean On Error GoTo ErrHan Set Ws1 = ThisWorkbook.Sheets(1) Set Ws2 = ThisWorkbook.Sheets(2) Set Ws3 = ThisWorkbook.Sheets(3) With Ws2 Columns("A:A").Select Ws2.Range("A:A").RemoveDuplicates Columns:=1, Header:=xlYes End With For iRow = 2 To Ws1.Cells(Ws1.Rows.Count, 2).End(xlUp).Row For i = 1 To Ws2.Cells(Ws2.Rows.Count, 1).End(xlUp).Row IsFound = False For j = 2 To Ws3.Cells(Ws3.Rows.Count, 1).End(xlUp).Row If LCase(Ws3.Cells(j, 1).Value) Like "*" & LCase(Ws2.Cells(i, 1).Value) & "*" Then IsFound = True Next j If Not IsFound And LCase(Ws1.Cells(iRow, 2).Value) Like "*" & LCase(Ws2.Cells(i, 1).Value) & "*" Then Ws1.Cells(iRow, 3).Value = Ws1.Cells(iRow, 3).Value & "," & Ws2.Cells(i, 1).Value End If Next i If InStr(1, Ws1.Cells(iRow, 3).Value, ",") > 0 Then Ws1.Cells(iRow, 3).Value = Right(Ws1.Cells(iRow, 3).Value, Len(Ws1.Cells(iRow, 3).Value) - 1) End If Next iRow Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing Exit Sub ErrHan: MsgBox "Sorry, an error occured:" & vbCrLf & Err.Description Set Ws1 = Nothing Set Ws2 = Nothing Set Ws3 = Nothing End Sub }是一个单独的词。我也希望它区分大小写。如果您可以添加行或告诉我如何修改它并解释添加的行或修改的行的作用,将会非常有用。

{{1}}

1 个答案:

答案 0 :(得分:1)

如果将句子或短语加载到变量类型的数组中,其中单词由空格键分隔,则可以遍历数组以查找完全匹配,而无需使用通配符。

Dim vList as variant
Dim vItem as variant

vlist = split(Ws3.Cells(j, 1).Value, " ")
for each vitem in vlist
  if instr(1, vitem, Ws2.Cells(i, 1).Value) > 0 then
    'do your replace/copy here
  endif
next vitem