尝试从macros表中过滤未被复制到个人的行

所以我有我的主表，我运行一个macros来复制一个模板，然后根据一列中的值填充某些行。 我需要添加一个检查，以便我可以告诉它，如果在另一列中的值符合指定的标准，不要拉行。 例如，如果列Y中的值匹配1234，但是只有列Z中的值不匹配456，则行x将被拉动。这是我现在使用的代码：

Option Explicit Sub Report() CreateDeptReport "Report" End Sub Sub CreateDeptReport(Report As String) Dim shtRpt As Excel.Worksheet, shtMaster As Excel.Worksheet Dim LCopyToRow As Long Dim LCopyToCol As Long Dim arrColsToCopy Dim c As Range, X As Integer On Error GoTo Err_Execute arrColsToCopy = Array(1, 3, 4, 8, 25, 16, 17, 15, 31, 7, 26) 'which columns to copy ? Set shtMaster = ThisWorkbook.Sheets("RawData") Set c = shtMaster.Range("Y5") 'Start search in Row 5 LCopyToRow = 10 'Start copying data to row 10 in Mental While Len(c.Value) > 0 'If value in column Y ends with "2135", copy to report sheet If c.Value Like "*2135" Then 'only create the new sheet if any records are found If shtRpt Is Nothing Then 'delete any existing sheet On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Sheets("NewSheetName").Delete Application.DisplayAlerts = True On Error GoTo 0 ThisWorkbook.Sheets("Template").Copy After:=shtMaster Set shtRpt = ThisWorkbook.Sheets(shtMaster.Index + 1) shtRpt.Name = "NewSheetName" 'rename new sheet to NewSheetName Range("F1").Value = "XXXX" Range("F2").Value = "XXXX" Range("B3").Value = Date Range("B4").Value = "XXXX" End If LCopyToCol = 1 shtRpt.Cells(LCopyToRow, LCopyToCol).EntireRow.Insert shift:=xlDown For X = LBound(arrColsToCopy) To UBound(arrColsToCopy) shtRpt.Cells(LCopyToRow, LCopyToCol).Value = _ c.EntireRow.Cells(arrColsToCopy(X)).Value LCopyToCol = LCopyToCol + 1 Next X LCopyToRow = LCopyToRow + 1 'next row End If Set c = c.Offset(1, 0) Wend ThisWorkbook.Worksheets("NewSheetName").Rows("9:9").Delete Range("A9").Select 'Position on cell A9 MsgBox "All matching data has been copied." Exit Sub Err_Execute: MsgBox "An error occurred." End Sub 

这就是我所拥有的; 我想尽可能less地进行重组，因为我知道这正是我想要保存这一个愚蠢的皱纹。 我已经尝试在c.Value行周围添加条件，但是我没有find任何地方。 感谢您的任何build议！

Answer 1

你的第一个标准范围被标记为“c”，所以我们叫你的第二个“d”。 在适当的地方添加这些行：

1. 在所有其他Dim语句之后，添加
   Dim d as range
2. set c行后，添加
   Set d = shtMaster.Range("Y5")
3. 更改
   If c.Value Like "*2135" Then到
   If c.Value Like "*2135" and d.Value not like "*456*" Then
4. 在Wend之前添加
   Set d = d.Offset(1, 0)

我可能错过了一两行，但基本上我试图保持相同的逻辑模式，并重复改变你的cvariables的行。 （如果我错过了一两行，请在评论中指出）