Как заставить цикл for слить новые значения по листам?

Question

У меня был кто-то, кто помог мне сделать начальный код для этого, я пытаюсь изменить его, но его неправильно.

Мне нужно сравнить лист 2 в электронной таблице с листами 4-10, и если значения строк e или b не соответствуют ни одной другой строке. скопируйте весь ряд в нижнюю часть листа 1.

Это то, что у меня есть до сих пор, но значение не установлено в true и оно печатается после каждого листа. Я придерживаться

Sub Button13() 'merge 

    Dim lastSourceRow As Long, LastTargetRow As Long, allSheets As Long, lastSheet As Long 
    Dim source As String, TARGET As Integer 
    Dim tempVal As String, tempValE, tempValT 
    Dim tRow As Long, lRow As Long, lCol As Long, nRow As Long 
    Dim match As Boolean 


    source = "Sheet2" 
    lastSheet = "10" 

    lastSourceRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).Row 


    For allSheets = 1 To lastSheet 


    TARGET = allSheets 
    LastTargetRow = Sheets(TARGET).Range("A" & Rows.Count).End(xlUp).Row 

    For lRow = 2 To lastSourceRow  'Loop through Rows on currentsheet 
     Count = "0" 
     match = False     'Reset boolean test for each new row 
     tempVal = Sheets(source).Cells(lRow, "B").Value  'Assign the tempValue to compare 
     tempValE = Sheets(source).Cells(lRow, "E").Value 

     For tRow = 2 To LastTargetRow 'Loop through entire target sheet 
     tempValT = Sheets(TARGET).Cells(tRow, "B").Value 
      If (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value And tempValE = Sheets(TARGET).Cells(tRow, "E").Value Then 
      match = True 
      ElseIf (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value And tempValE = "" Then 
      match = True 
      ElseIf (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value Then 
      match = True 
      'ElseIf Sheets(TARGET).Cells(tRow, "G").Value < DateAdd("m", -5, Date) Then 
      'match = True 
      End If 
     Next tRow 


     If match = False Then   'No Match found, copy row 
      nRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1 
      For lCol = 1 To 26  'Copy entire row by looping through 6 columns 
       Sheets("Sheet1").Cells(nRow, lCol).Value = Sheets(source).Cells(lRow, lCol).Value 
      Next lCol 
     End If 

    Next lRow 
    Next allSheets 

End Sub 

Answer 1

У вас есть 2 проблемы:

проблемы 1: вы сбросу match = False внутри цикла lRow, это должно быть внутри цикла tRow, в противном случае, если первые match = True хиты тогда match никогда не сбрасывается

проблема 2: If match = False Then не может быть введен потому, что он находится вне вашей петли tRow. так match устанавливается внутри цикла, но не может быть достигнуто If match = False Then

поэтому рабочий код должен быть

Sub Button13() 'merge 

    Dim lastSourceRow As Long, LastTargetRow As Long, allSheets As Long, lastSheet As Long 
    Dim source As String, TARGET As Integer 
    Dim tempVal As String, tempValE, tempValT 
    Dim tRow As Long, lRow As Long, lCol As Long, nRow As Long 
    Dim match As Boolean 


    source = "Sheet2" 
    lastSheet = "10" 

    lastSourceRow = Sheets(source).Range("A" & Rows.Count).End(xlUp).Row 


    For allSheets = 1 To lastSheet 


    TARGET = allSheets 
    LastTargetRow = Sheets(TARGET).Range("A" & Rows.Count).End(xlUp).Row 

    For lRow = 2 To lastSourceRow  'Loop through Rows on currentsheet 
     Count = "0" 

     tempVal = Sheets(source).Cells(lRow, "B").Value  'Assign the tempValue to compare 
     tempValE = Sheets(source).Cells(lRow, "E").Value 

     For tRow = 2 To LastTargetRow 'Loop through entire target sheet 
     tempValT = Sheets(TARGET).Cells(tRow, "B").Value 
      If (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value And tempValE = Sheets(TARGET).Cells(tRow, "E").Value Then 
      match = True 
      ElseIf (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value And tempValE = "" Then 
      match = True 
      ElseIf (allSheets <> 2 Or allSheets <> 3) And tempVal = Sheets(TARGET).Cells(tRow, "B").Value Then 
      match = True 
      'ElseIf Sheets(TARGET).Cells(tRow, "G").Value < DateAdd("m", -5, Date) Then 
      'match = True 
      End If 


     If match = False Then   'No Match found, copy row 
      nRow = Sheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1 
      For lCol = 1 To 26  'Copy entire row by looping through 6 columns 
       Sheets("Sheet1").Cells(nRow, lCol).Value = Sheets(source).Cells(lRow, lCol).Value 
      Next lCol 
     End If 

'2 moved lines 
match = False     'Reset boolean test for each new row 
Next tRow 

    Next lRow 
    Next allSheets 

End Sub