已经完成了，非常感谢大家的帮助。学习到了很多知识

lzq38576537

已经完成了，非常感谢大家的帮助。学习到了很多知识

gbgbxgb

1. Sub theSearchWord()
   
2.     Dim arr As Variant, brr As Variant, crr As Variant
   
3.     Dim reg As Object, theStr$, thePattern$, i&, j&, theFinalRow&
   
4.     '
   
5.     With Sheet1
   
6.         theFinalRow = .Cells(.Rows.Count, 1).End(xlUp).Row
   
7.         If theFinalRow = 1 Then GoTo The_Exit
   
8.         With .Range(.Cells(1, 1), .Cells(theFinalRow, 1))
   
9.             arr = .Value
   
10.             .Offset(1, 1).ClearContents
    
11.         End With
    
12.         ReDim crr(1 To UBound(arr) - 1, 1 To 1)
    
13.         theFinalRow = .Cells(.Rows.Count, 3).End(xlUp).Row
    
14.         If theFinalRow = 1 Then GoTo The_Exit
    
15.         brr = .Range(.Cells(1, 3), .Cells(theFinalRow, 3))
    
16.         '
    
17.         Set reg = CreateObject("VBScript.RegExp")
    
18.         With reg
    
19.             .Global = True
    
20.             .ignorecase = True
    
21.             For i = 2 To UBound(arr)
    
22.                 theStr = arr(i, 1)
    
23.                 For j = 2 To UBound(brr)
    
24.                     thePattern = "(^|\b)" & brr(j, 1) & "(\b|$)"
    
25.                     .Pattern = thePattern
    
26.                     If .Test(theStr) Then
    
27.                         crr(i - 1, 1) = "是"
    
28.                         Exit For
    
29.                     End If
    
30.                 Next j
    
31.             Next i
    
32.         End With
    
33.         .Cells(2, 2).Resize(UBound(arr) - 1) = crr
    
34.     End With
    
35. The_Exit:
    
36.     Set reg = Nothing
    
37. End Sub
    

复制代码

jsqb

用SQL uPdate命令修改

lzq38576537

gbgbxgb 发表于 2018-8-25 19:27

非常感谢你写了这么多，但是由于我原数据是多个表格，你用了WITH，我看的不是很懂，可以帮我重新写个代码吗？再次表示感谢

hcm19522

=IF(ISERR(FIND(" Cool "," "&A2&" ")),"","V")

iwangyi

Sub CC()
Set c = Columns("a:a").Find("cool", , , 1)
If Not c Is Nothing Then c.Offset(, 1) = "是"
End Sub

gbgbxgb

lzq38576537 发表于 2018-8-25 21:28
非常感谢你写了这么多，但是由于我原数据是多个表格，你用了WITH，我看的不是很懂，可以帮我重新写个代码 ...

求助的说明及附件遮遮掩掩导致跟帖者编写的代码驴头不对马嘴。

若求助的说明和附件再次更新，恕本人失去耐心和兴趣，不再跟贴。

iwangyi

Sub CC()
Set c = Columns("a:a").Find("cool", , , 1)
If Not c Is Nothing Then c.Offset(, 1) = "是"
End Sub

iwangyi

附件请参考

jiminyanyan

这是来干啥的。。。