Сравнение столбцов Excel VBA, сравнение и смещение

Question

Я хочу знать лучший и быстрый способ сравнить два столбца и смещать согласованные значения. Я хочу компенсировать всю строку данных, а не только ячейку, как указано.

Вот мой код:

Sub ForRawMatches() Application.ScreenUpdating = False

'Declare variables 
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean, dar As Range 

    'Set up the count as the number of filled rows in the first column of Sheet1. 
    iRowL = Cells(Rows.Count, 2).End(xlUp).Row 

    'Cycle through all the cells in that column: 
    For iRow = 2 To iRowL 
     'For every cell that is not empty, search through the first column in each worksheet in the 
     'workbook for a value that matches that cell value. 

     If Not IsEmpty(Cells(iRow, 2)) Then 
     For iSheet = ActiveSheet.Index + 1 To Worksheets.Count 
      bln = False 
      var = Application.Match(Cells(iRow, 2).Value, Worksheets(iSheet).Columns(2), 0) 

      'If you find a matching value, indicate success by setting bln to true and exit the loop; 
      'otherwise, continue searching until you reach the end of the workbook. 
      If Not IsError(var) Then 
       bln = True 
       Exit For 
      End If 
     Next iSheet 
     End If 

     'If you do not find a matching value, do not bold the value in the original list; 
     'if you do find a value, bold it. 
     If bln = False Then 
     Cells(iRow, 2).Font.Bold = True 

     'this offsets cell value 
     Cells(iRow, 1).Offset(7500, 0) = Cells(iRow, 1).Value 



     Else 
     Cells(iRow, 2).Font.Bold = False 

     End If 
    Next iRow 
Application.ScreenUpdating = True 

End Sub

Answer 1

Я использовал пример Luuklag и помещены данные для сравнения на другом листе. Код выглядит следующим образом:

Sub ForRawMatches()

Application.ScreenUpdating = False 

'Declare variables 
Dim var As Variant, iSheet As Integer, iRow As Long, iRowL As Long, bln As Boolean, dar As Range 

    'Set up the count as the number of filled rows in the first column of Sheet1. 
    iRowL = Cells(Rows.Count, 2).End(xlUp).Row 







    'Cycle through all the cells in that column: 
    For iRow = 2 To iRowL 
     'For every cell that is not empty, search through the first column in each worksheet in the 
     'workbook for a value that matches that cell value. 

     If Not IsEmpty(Cells(iRow, 2)) Then 
     For iSheet = ActiveSheet.Index + 1 To Worksheets.Count 
      bln = False 
      var = Application.Match(Cells(iRow, 2).Value, Worksheets(iSheet).Columns(8), 0) 

      'If you find a matching value, indicate success by setting bln to true and exit the loop; 
      'otherwise, continue searching until you reach the end of the workbook. 
      If Not IsError(var) Then 
       bln = True 
       Exit For 
      End If 
     Next iSheet 
     End If 

     'If you do not find a matching value, do not bold the value in the original list; 
     'if you do find a value, bold it. 
     If bln = False Then 
     Cells(iRow, 2).Font.Bold = False 

     Else 
     Cells(iRow, 2).Font.Bold = True 
     Range("K2:K10000").NumberFormat = "000000000000" 
      Range(Cells(iRow, 1), Cells(iRow, 34)).Offset(3500, 0) = Range(Cells(iRow, 1), Cells(iRow, 34)).Value 
     End If 
    Next iRow 
Application.ScreenUpdating = True 

End Sub