Уважаемые форумчане. В форуме нашел очень хороший макрос,до сих пор пользовался,но моя база увеличилась до несколько десятков тысяч и комп начил тормозить по-страшному.Помогите пожалуста ускорить этот процесс.Зараннее благодарен.  
 
Sub Translate() 'этот макрос переводит слова с одного языка на другой      
Dim cell1 as Range, cell2 As Range      
Dim i as Long, Langs As Long      
   
Langs = 3 'количество языков перевода, включая русский      
   
   For Each cell1 In ActiveSheet.Cells.SpecialCells(xlCellTypeConstants)      
       For Each cell2 In Worksheets("Словарь").Cells.SpecialCells(xlCellTypeConstants)      
           If cell1.Value = cell2.Value Then      
               i = cell2.Column      
               If i = Langs Then i = 1 Else i = i + 1      
               cell1.Value = Worksheets("Словарь").Cells(cell2.Row, i).Value      
               GoTo 1      
           End If      
       Next cell2      
1:   Next cell1      
End Sub      
   
Sub ScanText() 'этот макрос копирует все слова текущей книги в      
' столбец А на лист "Словарь"      
   i = 0      
   For Each sht In ActiveWorkbook.Sheets      
   If sht.Name = "Словарь" Then GoTo 2      
   For Each cell In sht.Cells.SpecialCells(xlCellTypeConstants)      
       c = Asc(cell.Value)      
       If (c >= 65 And c <= 122) Or (c >= 192 And c <= 255) Then      
           cell.Copy Destination:=Worksheets("Словарь").Range("A1").Offset(i, 0)      
           i = i + 1      
       End If      
   Next cell      
2:  Next sht      
End Sub