根据一个单元格跳过特定行的excel宏

Question

我有一个包含2个表的xlsm文件。还有一个Macro代码，用于在两个工作表之间进行比较，进行一些更改，并创建第三个新工作表作为比较的输出。

Option Explicit
Option Compare Text
Sub RNCAudit()
Dim WS_Count As Integer
Dim wsheet As Integer
Dim RNC As String
Dim object1 As String
Dim object2 As String
Dim object3 As String
Dim object4 As String
Dim object5 As String
Dim object6 As String
Dim j As Single
Dim k As Integer
Dim parameter As String
Dim res As String
Dim value As String
Dim oldvalue As String
k = 2
Application.ScreenUpdating = False
WS_Count = ActiveWorkbook.Worksheets.Count
ActiveWorkbook.Worksheets.Add
ActiveSheet.Move After:=Sheets(ActiveWorkbook.Sheets.Count)
ActiveWorkbook.Worksheets(WS_Count + 1).Name = "Output"
Worksheets(WS_Count + 1).Select
Worksheets(WS_Count + 1).Cells(1, 1) = "Command"
Worksheets(WS_Count + 1).Cells(1, 2) = "RNC"
Worksheets(WS_Count + 1).Cells(1, 3) = "Object_2"
Worksheets(WS_Count + 1).Cells(1, 4) = "Object_3"
Worksheets(WS_Count + 1).Cells(1, 5) = "Object_4"
Worksheets(WS_Count + 1).Cells(1, 6) = "Object_5"
Worksheets(WS_Count + 1).Cells(1, 7) = "Object_6"
Worksheets(WS_Count + 1).Cells(1, 8) = "Parameter_ID"
Worksheets(WS_Count + 1).Cells(1, 9) = "Current_Setting"
Worksheets(WS_Count + 1).Cells(1, 10) = "Target_Setting"

For wsheet = 3 To WS_Count
RNC = ActiveWorkbook.Worksheets(wsheet).Name

j = 2

While Worksheets("RNC_BaseLine").Cells(j, 1) <> ""
Application.ScreenUpdating = False
parameter = Trim(Worksheets("RNC_BaseLine").Cells(j, 1))
object1 = Trim(Worksheets("RNC_BaseLine").Cells(j, 2))
object2 = Trim(Worksheets("RNC_BaseLine").Cells(j, 3))
object3 = Trim(Worksheets("RNC_BaseLine").Cells(j, 4))
object4 = Trim(Worksheets("RNC_BaseLine").Cells(j, 5))
object5 = Trim(Worksheets("RNC_BaseLine").Cells(j, 6))
object6 = Trim(Worksheets("RNC_BaseLine").Cells(j, 7))
value = Find_Value(wsheet, WS_Count, object1, object2, object3, object4, object5, object6, parameter)
oldvalue = Worksheets("RNC_BaseLine").Cells(j, 8)
If oldvalue <> value Then
Worksheets("Output").Cells(k, 1) = "Set " & object1
Worksheets("Output").Cells(k, 2) = RNC
Worksheets("Output").Cells(k, 3) = object2
Worksheets("Output").Cells(k, 4) = object3
Worksheets("Output").Cells(k, 5) = object4
Worksheets("Output").Cells(k, 6) = object5
Worksheets("Output").Cells(k, 7) = object6
Worksheets("Output").Cells(k, 8) = parameter
Worksheets("Output").Cells(k, 9) = value
Worksheets("Output").Cells(k, 10) = Worksheets("RNC_BaseLine").Cells(j, 8)

k = k + 1
End If
Application.ScreenUpdating = False
j = j + 1
Wend

Next

MsgBox "Done at " & Time

End Sub

下面是进行比较的代码

Private Function Find_Value(ByVal wsheet As Integer, ByVal WS_Count As Integer, _
ByVal object1 As String, ByVal object2 As String, ByVal object3 As String, _
ByVal object4 As String, ByVal object5 As String, ByVal object6 As String, _
ByVal parameter As String) As String

Dim i As Single
Dim j As Single
Dim encontrado As Boolean
Dim encontrado2 As Boolean
Dim SRH As Boolean
Dim j2 As Single
Dim j3 As Single
Dim j4 As Single
Dim j5 As Single
Dim j6 As Single
Dim FindString As String
Dim Rng As Range
Dim Rng2 As String
Dim coma_pos As Integer
Dim coma_pos_1 As Integer
Dim coma_pos_2 As Integer
Dim coma_pos_3 As Integer
Dim colparam As Integer
Dim find_type As Integer
Dim valor As String
encontrado = False
encontrado2 = False
SRH = False
i = 2

find_type = 1
If Len(Trim(object2)) > 0 Then
find_type = find_type + 1
End If
If Len(Trim(object3)) > 0 Then
find_type = find_type + 1
End If
If Len(Trim(object4)) > 0 Then
find_type = find_type + 1
End If
If Len(Trim(object5)) > 0 Then
find_type = find_type + 1
End If
If Len(Trim(object6)) > 0 Then
find_type = find_type + 1
End If

With Worksheets(wsheet).Range("A:A")
Set Rng = .Find(What:=object1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
End If
End With
While ((encontrado = False) And (encontrado2 = False))

If SRH = True Then

With Worksheets(wsheet).Range(Selection.Offset(1, 0), Selection.End(xlDown))
Set Rng = .Find(What:=object1, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End If

If Not Rng Is Nothing Then
Application.Goto Rng, True


Select Case find_type
Case 1
If InStr(Rng, parameter) > 0 Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Case 2

If (InStr(Rng, parameter) > 0) Then
If (InStr(Rng, object2) > 0) Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Case 3

If (InStr(Rng, parameter) > 0) Then
If (InStr(Rng, object2) > 0) Then
If (InStr(Rng, object3) > 0) Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If

Else
encontrado = False
SRH = True
End If
Case 4

If (InStr(Rng, parameter) > 0) Then
If (InStr(Rng, object2) > 0) Then
If (InStr(Rng, object3) > 0) Then
If (InStr(Rng, object4) > 0) Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Case 5

If (InStr(Rng, parameter) > 0) Then
If (InStr(Rng, object2) > 0) Then
If (InStr(Rng, object3) > 0) Then
If (InStr(Rng, object4) > 0) Then
If (InStr(Rng, object5) > 0) Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Case 6

If (InStr(Rng, parameter) > 0) Then
If (InStr(Rng, object2) > 0) Then
If (InStr(Rng, object3) > 0) Then
If (InStr(Rng, object4) > 0) Then
If (InStr(Rng, object5) > 0) Then
If (InStr(Rng, object6) > 0) Then
encontrado = True
valor = Mid(Rng, InStr(Rng, parameter) + Len(parameter) + 1, 200)
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
Else
encontrado = False
SRH = True
End If
End Select
Else
encontrado2 = True
End If
Wend
'Else
'End If
'End If
'End With

'Wend



If encontrado = True Then
coma_pos_1 = InStr(valor, ",")
coma_pos_2 = InStr(valor, "&")
coma_pos_3 = InStr(valor, ";")

If coma_pos_1 > 0 Then
coma_pos = coma_pos_1
If coma_pos_2 > 0 Then
If coma_pos_2 < coma_pos_1 Then
coma_pos = coma_pos_2
End If
End If
If coma_pos_3 > 0 Then
If coma_pos_3 < coma_pos Then
coma_pos = coma_pos_3
End If
End If
Else
If coma_pos_2 > 0 Then
coma_pos = coma_pos_2
If coma_pos_3 > 0 Then
If coma_pos_3 < coma_pos Then
coma_pos = coma_pos_3
End If
End If
Else
If coma_pos_3 > 0 Then
coma_pos = coma_pos_3
End If
End If
End If
Find_Value = Left(valor, coma_pos - 1)


Else
Find_Value = "NOT_FOUND"
End If
If encontrado2 = True Then
Find_Value = "NOT_FOUND"
End If
'End If

'End With
On Error Resume Next

'End With
End Function

我需要做的是:-

我在第一个工作表中添加了一个新列(CAT)，该列的单元格要么为空，要么为值(忽略)。

我需要我的代码在比较之前检查该单元格，如果(CAT)单元格等于"ignore"，则跳过整行的比较。

我希望我说的够清楚了

提前谢谢你

Answer 1

只需要添加几行，就像这样:

Dim ws as Worksheet
Set ws = Worksheets("RNC_BaseLine")
'...
'...
While ws.Cells(j, 1) <> ""
Application.ScreenUpdating = False
'adjust "10" to the position of your column
If ws.Cells(j, 10).Value <> "ignore" Then

'do the rest of the checks
End If 'not "ignore"
'...
'...