根據一個單元格跳過特定行中的 excel 宏
[英]Skip excel macro in specific row according to one cell
問題描述
我有一個包含 2 張紙的 xlsm 文件。 還有一個宏代碼在兩張表之間進行比較，進行一些更改，並創建第三張新表作為比較的 output。
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)，該列的單元格要么為空，要么值為 (ignore)。
我需要我的代碼在比較之前檢查該單元格，如果（CAT）單元格等於“忽略”，則跳過整行的比較。
我希望這已經足夠清楚了
先感謝您
1 個解決方案
解決方案1
1 已采納 2021-02-17 02:18:23
只需要添加幾行這樣的東西：
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"
'...
'...
Macro Excel可根據單元格匹配將范圍單元格從一張紙復制到另一張紙，如果不匹配，則跳過單元格
[英]Macro Excel to copy range cells from one sheet to another based on cell match and skip cell if no match
Excel宏可將單元格的特定行從一個工作表剪切到另一個工作表
[英]Excel macro to cut a specific row of cells from one worksheet to another
使用宏打印 excel 文件。 但是如果一行中的值為0，那么你跳過它
[英]Print an excel file using Macro. But if the value in one row is 0 then you skip it
聲明:本站的技術帖子網頁，遵循CC BY-SA 4.0協議，如果您需要轉載，請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.