我正在搜索一列以查找包含文本并且前6个字符中不包含单词“ cat”的单元格（需要区分大小写）。然后，将整行剪切为另一张纸。没有编译错误，无法使代码运行。下面的代码是我尝试更改它之前。我不知道如何编码以查看前6个字符。
尝试了instr和iserror，但是我认为我现有的代码只需要进行很小的改动就可以逃脱。
Sub CATDEFECTS()
UsdRws = Range("C" & Rows.Count).End(xlUp).Row
For i = UsdRws To 2 Step -1
If Range("C" & i).Value Like "<>""" And Range("c" & i).Value Like "CAT" Then
Rows(i).Cut Sheets("AWP DEFECTS").Range("A" & rows.Count).End(xlUp).Offset(1)
Rows(i).Delete
End If
Next i
End Sub
答案 0 :(得分：2)
不管您决定如何实现该宏，查看单元格是否为空白的测试都是完全多余的。您只需要测试单元格是否符合您的CAT标准即可。如果是这样，则绝对不是空白，因此无需测试。
您可以使用LEFT(Range, 6)
If Left(Range("C" & i), 6) Like "*CAT*" Then
这需要Option Compare才能工作（感谢@Comintern）
我更喜欢这种方法。它是显式的，不会删除或移动循环内的任何内容，因此可以最大程度地减少您的操作语句。
Sub Cat()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<--UPDATE
Dim ps As Worksheet: Set ps = ThisWorkbook.Sheets("AWP DEFECTS")
Dim LR As Long, DeleteMe As Range, i As Long
LR = ws.Range("C" & ws.Rows.Count).End(xlUp).Row
For i = 2 To LR
If InStr(Left(ws.Range("C" & i), 6), "CAT") Then
If Not DeleteMe Is Nothing Then
Set DeleteMe = Union(DeleteMe, ws.Range("C" & i))
Else
Set DeleteMe = ws.Range("C" & i)
End If
End If
Next i
Application.ScreenUpdating = False
If Not DeleteMe Is Nothing Then
LR = ps.Range("A" & ps.Rows.Count).End(xlUp).Row
DeleteMe.EntireRow.Copy ps.Range("A" & LR)
DeleteMe.EntireRow.Delete
End If
Application.ScreenUpdating = True
End Sub
答案 1 :(得分：0)
如果 cat 位于前6个字符之内，则InStr将报告其位置小于5。
Sub CATDEFECTS()
dim UsdRws as long, pos as long
UsdRws = Range("C" & Rows.Count).End(xlUp).Row
For i = UsdRws To 2 Step -1
pos =instr(1, cells(i, "C").value2, "cat", vbtextcompare)
If pos > 0 and pos < 5 Then
Rows(i).Cut Sheets("AWP DEFECTS").Range("A" & rows.Count).End(xlUp).Offset(1)
Rows(i).Delete
End If
Next i
End Sub
答案 2 :(得分：0)
要在源工作表中删除行，必须在常量部分将cDEL设置为True。调整其他常量以适合您的需求。
Option Explicit
'Option Compare Text
Sub CATDEFECTS()
With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
On Error GoTo ProcedureExit
' Source Constants
Const cSource As Variant = "Sheet1" ' Worksheet Name/Index
Const cCol As Variant = "C" ' Search Column Letter/Number
Const cFirstR As Long = 2 ' First Row Number
Const cChars As Long = 6 ' Number of Chars
Const cSearch As String = "CAT" ' Search String
' Target Constants
Const cTarget As Variant = "AWP DEFECTS" ' Worksheet Name/Index
Const cColTgt As Variant = "A" ' Column Letter/Number
Const cFirstRTgt As Long = 2 ' First Row Number
Const cDEL As Boolean = False ' Enable Delete (True)
' Variables
Dim rngH As Range ' Help Range
Dim rngU As Range ' Union Range
Dim vntS As Variant ' Source Array
Dim i As Long ' Source Range Row Counter
' The Criteria
' When the first "cChars" characters do not contain the case-INsensitive
' string "cSearch", the criteria is met.
' Source Worksheet
With ThisWorkbook.Worksheets(cSource)
' Calculate Last Cell in Search Column using the Find method and
' assign it to Help (Cell) Range.
Set rngH = .Columns(cCol).Find("*", , xlFormulas, _
xlWhole, xlByColumns, xlPrevious)
' Calculate Source Column Range from Help (Cell) Range.
If Not rngH Is Nothing Then ' Last Cell was found.
' Calculate Source Column Range and assign it to
' Help (Column) Range using the Resize method.
Set rngH = .Cells(cFirstR, cCol).Resize(rngH.Row - cFirstR + 1)
' Copy Help (Column) Range into 2D 1-based 1-column Source Array.
vntS = rngH
' Show hidden rows to prevent the resulting rows (the rows to be
' hidden or deleted) to appear hidden in Target Worksheet.
rngH.EntireRow.Hidden = False
Else ' Last Cell was NOT found (unlikely).
MsgBox "Empty Column '" & cCol & "'."
GoTo ProcedureExit
End If
' Loop through rows of Source Array.
For i = 1 To UBound(vntS)
' Check if current Source Array value doesn't meet Criteria.
If InStr(1, Left(vntS(i, 1), cChars), cSearch, vbTextCompare) = 0 _
Then ' "vbUseCompareOption" if "Option Compare Text"
' Note: To use the Like operator instead of the InStr function
' you have to use (uncomment) "Option Compare Text" at the beginning
' of the module for a case-INsensitive search and then outcomment
' the previous and uncomment the following line.
' If Not Left(vntS(i, 1), cChars) Like "*" & cSearch & "*" Then
Set rngH = .Cells(i + cFirstR - 1, cCol)
If Not rngU Is Nothing Then
' Union Range contains at least one range.
Set rngU = Union(rngU, rngH)
Else
' Union Range does NOT contain a range (only first time).
Set rngU = rngH
End If
End If
Next
End With
' Target Worksheet
If Not rngU Is Nothing Then ' Union Range contains at least one range.
With ThisWorkbook.Worksheets(cTarget)
' Calculate Last Cell in Search Column using the Find method and
' assign it to Help Range.
Set rngH = .Columns(cColTgt).Find("*", , xlFormulas, _
xlWhole, xlByColumns, xlPrevious)
' Calculate Last Cell from Help Range, but in column 1 ("A").
If Not rngH Is Nothing Then ' Last Cell was found.
Set rngH = .Cells(rngH.Row + 1, 1)
Else ' Last Cell was NOT found.
Set rngH = .Cells(cFirstRTgt - 1, 1)
End If
' Copy the entire Union Range to Target Worksheet starting from
' Help Range Row + 1 i.e. the first empty row (in one go).
' Note that you cannot Cut/Paste on multiple selections.
rngU.EntireRow.Copy rngH
End With
' Hide or delete the transferred rows (in one go).
If cDEL Then ' Set the constant cDEL to True to enable Delete.
rngU.EntireRow.Delete
Else ' While testing the code it is better to use Hidden.
rngU.EntireRow.Hidden = True
End If
End If
ProcedureExit:
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With
End Sub
InStr函数比Like运算符快几毫秒。