Сопоставление данных на двух листах - VB

Формулировка задачи:

Нужно оптимизировать такой макрос:
сопоставляет данные одного листа с данными другого листа и дополняет первый лист колонкой с соответствующими значениями со второго листа.
вот код

Admin()
    Sheets().Cells(, ).Value = ()
    Sheets().
    i_z = Sheets().Cells(, ).Value
    i_nvs = Sheets().Cells(, ).Value
    
     i =   i_nvs
    
      (Cells(i, ).Value <> )  (Cells(i, ).Value = ) 
     
        Find = Trim(Cells(i, ).Value)
        
         j =   i_z  
         Trim(Sheets().Cells(j, ).Value) = Find 
        Sheets().Cells(i, ).Value = Sheets().Cells(j, ).Value
         Sheets().Cells(j, ).Value <> Sheets().Cells(i, ).Value 
        Sheets().Cells(i, ).Font.ColorIndex = 

         j

        Sheets().Cells(, ).Value = ()

     i
    
 

выполняется жутко долго. количество записей и на первом листе и на втором - по 40-60 тыс.

Решение задачи: «Сопоставление данных на двух листах»

textual
                            Листинг программы 
                        

                            <font color="blue">Sub</font> test()
 <font color="blue">Dim</font> ch <font color="blue">As</font> Range
 <font color="blue">Dim</font> c <font color="blue">As</font> Range
 <font color="blue">Dim</font> firstAddress <font color="blue">As</font> <font color="blue">String</font>
 <font color="blue">Dim</font> ran1 <font color="blue">As</font> Range
 <font color="blue">Dim</font> ran2 <font color="blue">As</font> Range
 
 Application.ScreenUpdating = False
 Application.Calculation = xlCalculationManual

 <font color="blue">Set</font> ran1 = Intersect(Worksheets(<font color="darkblue"><b>1</b></font>).UsedRange, Worksheets(<font color="darkblue"><b>1</b></font>).Columns(<font color="darkblue"><b>1</b></font>))
 <font color="blue">Set</font> ran2 = Intersect(Worksheets(<font color="darkblue"><b>2</b></font>).UsedRange, Worksheets(<font color="darkblue"><b>2</b></font>).Columns(<font color="darkblue"><b>1</b></font>))
  
 
 <font color="blue">For</font> <font color="blue">Each</font> ch <font color="blue">In</font> ran2
  <font color="blue">Set</font> c = ran1.Find(ch.Value, LookIn:=xlValues)
    
  <font color="blue">If</font> <font color="blue">Not</font> c <font color="blue">Is</font> <font color="blue">Nothing</font> <font color="blue">Then</font>
   firstAddress = c.Address
   <font color="blue">Do</font>
     <font color="blue">If</font> c.Value = ch.Value <font color="blue">Then</font>
       c.Offset(<font color="darkblue"><b>0</b></font>, <font color="darkblue"><b>1</b></font>).Value = ch.Offset(<font color="darkblue"><b>0</b></font>, <font color="darkblue"><b>2</b></font>).Value
     <font color="blue">End</font> <font color="blue">If</font>
     <font color="blue">Set</font> c = ran1.FindNext(c)
   <font color="blue">Loop</font> <font color="blue">While</font> <font color="blue">Not</font> c <font color="blue">Is</font> <font color="blue">Nothing</font> <font color="blue">And</font> c.Address <> firstAddress
  <font color="blue">End</font> <font color="blue">If</font>
 <font color="blue">Next</font> ch
 
 
 Application.Calculation = xlCalculationAutomatic
 Application.ScreenUpdating = True

<font color="blue">End</font> <font color="blue">Sub</font>

                        