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;

fio:=Query1.FieldByName('fio').AsString;
ordinal:=Query1.FieldByName('ordinal').AsString;

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