begin
   Excel.Modules.Add(EmptyParam, EmptyParam, 1);
   temp := 'Sub mymacros()' + #13;
   temp := temp + 'Dim a As Workbook' + #13;
   temp := temp + 'Dim lLastRow As Long' + #13;
   temp := temp + 'Dim i As Long' + #13;
   temp := temp + 'Set a = ThisWorkbook' + #13;
   temp := temp + 'lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count' + #13;
   temp := temp + 'Application.ScreenUpdating = False' + #13;
   temp := temp + 'For i = lLastRow To 1 Step -1' + #13;
   Query1.Open;
      while not Query1.Eof do
         begin
         fio:=Query1.FieldByName('fio').AsString;
         ordinal:=Query1.FieldByName('ordinal').AsString;
         temp:=temp + 'if a.Sheets("sheet1").Cells(i, 6).Text like "' + fio + '*" then a.Sheets("sheet1").Cells(i, 6) = "' + ordinal + '"' + #13;
         Query1.Next;
         end;
   temp:=temp + 'Next i' + #13;
   temp:=temp + 'End Sub' + #13;
   WorkBook.VBProject.VBComponents.Item(1).Codemodule.AddFromString(temp);
   Excel.Run('mymacros');
   CMod:=Excel.ActiveWorkbook.VBProject.VBComponents.Item(1).CodeModule;
   StartLine:=CMod.ProcStartLine['mymacros', 0];
      if StartLine > 0 then
         begin
         LineCount:=CMod.ProcCountLines['mymacros', 0];
         CMod.DeleteLines(StartLine, LineCount);
         end;
   Query1.Close;
end;

Sub mymacros()
Dim a As Workbook
Dim lLastRow As Long
Dim i As Long
Set a = ThisWorkbook
lLastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Application.ScreenUpdating = False
For i = lLastRow To 1 Step -1
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апасов К*" Then a.Sheets("sheet1").Cells(i, 6) = "157"
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апатров У*" Then a.Sheets("sheet1").Cells(i, 6) = "166"
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апацкий В*" Then a.Sheets("sheet1").Cells(i, 6) = "1958"
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апдоров М*" Then a.Sheets("sheet1").Cells(i, 6) = "1509"
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апеллесов Ю*" Then a.Sheets("sheet1").Cells(i, 6) = "340"
If a.Sheets("sheet1").Cells(i, 6).Text Like "Апель А*" Then a.Sheets("sheet1").Cells(i, 6) = "1261"
{тут ещё тысячи ФИО и их id}
Next i
End Sub