试图在一个string中find一个带有循环的字母集合

我试图做一个循环检查列A中的所有单元格，如果它发现任何一个string中包含短语“ISAW”（如1314_ISAW_STUFF），那么它将列G中相应的单元格的值更改为“符合规定”。

我有以下代码，循环工作和Cells.Find选项应该可以工作，但它不会激活任何具有匹配条件的单元格。

Sub mytestsub() Dim sh1 As Worksheet Set sh1 = Worksheets("Sheet1") Dim i As Integer sh1.Activate On Error GoTo MyError For i = 1 To InStr(ActiveSheet, "ISAW") sh1.Cells.Find("ISAW").Activate If InStr(ActiveCell, "ISAW") > 0 Then ActiveCell.Offset(, 7).Value = "COMPLIANT" End If Next i MyError: On Error GoTo -1 End Sub 

任何帮助，将不胜感激！

我改变了汤姆慷慨提供的脚本，如下所示，但现在似乎没有工作。

  Sub bugfix() 'QA N/A bugfix' Dim fndCell As Range Dim FirstAddress As String Worksheets("Summary").Unprotect With Worksheets("Summary") .Activate On Error GoTo MyError Set fndCell = .Column(3).Find(what:="ISAW", lookat:=xlPart) If Not fndCell Is Nothing Then ' uncomment if you really want to visually track the cells 'fndCell.Activate FirstAddress = fndCell.Address Do fndCell.Offset(0, 6).Value = "N/A" Set fndCell = .Cells.FindNext(fndCell) Loop Until fndCell.Address = FirstAddress End If End With Exit Sub MyError: On Error GoTo -1 End Sub 

Answer 1

几乎没有理由Activate或使用ActiveCell来检查某个值，或更改另一个单元格的值。 而是使用完全限定的对象。

另外，在这种情况下，使用On Error GoTo MyError不是必需的，请参阅下面的代码。

码

 Sub mytestsub() Dim sh1 As Worksheet Dim i As Long, LastRow As Long Set sh1 = Worksheets("Sheet1") With sh1 LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row ' get last row with data in column "A" For i = 1 To LastRow If InStr(.Range("A" & i).Value2, "ISAW") > 0 Then ' check if current cell in column "A" contains "ISAW" .Range("G" & i).Value2 = "COMPLIANT" ' change the value at column "G" End If Next i End With End Sub 

Answer 2

我可以理解，可能有充分的理由使用VBA，但我可以build议一个公式作为选项，在列G中的第一个数据单元格，然后复制

 =IF(ISERR(FIND("ISAW",A1,1)),"","COMPLIANT") 

如果find了它，那么它会查找你的string，然后返回它的开始位置，否则返回#VALUE 。 封装的IF语句将其转换为COMPLIIANT或为空。

Answer 3

使用Find和FindNext来执行此操作。 这将查找Sheet1中包含"ISAW"所有单元格，并更新列G的值。 另外，在error handling之前，请确保在error handling过程之前Exit Sub ，否则会运行，无论是否有错误。

评论后更新

它没有做任何事情的原因是因为你的代码实际上有一个错误，但它是由你的On Error GoTo MyError 。 我已经更新了一个固定的代码

 Sub bugfix() 'QA N/A bugfix' Dim fndCell As Range Dim FirstAddress As String With Worksheets("Summary") .Unprotect .Activate On Error GoTo MyError Set fndCell = .Columns(3).Find(what:="ISAW", lookat:=xlPart) If Not fndCell Is Nothing Then ' uncomment if you really want to visually track the cells 'fndCell.Activate FirstAddress = fndCell.Address Do fndCell.Offset(0, 6).Value = "N/A" Set fndCell = .Columns(3).FindNext(fndCell) Loop Until fndCell.Address = FirstAddress End If End With Exit Sub MyError: On Error GoTo -1 End Sub