Здравствуйте!  
В коде формы есть такие строки:  
 
Private Sub AktSeals1_Change()  
Proverka  
End Sub  
 
Private Sub AktSeals2_hange()  
Proverka  
End Sub  
 
....  
 
Private Sub AktSeals40_Change()  
Proverka  
End Sub  
 
Еще такие:  
 
Private Sub AktSeals1_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
Private Sub AktSeals2_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
.....  
 
Private Sub AktSeals40_KeyPress(ByVal KeyAscii As MSForms.ReturnInteger)  
If (KeyAscii < 48 Or KeyAscii > 57) Then KeyAscii = 0  
End Sub  
 
Возможно ли написать этот код сокращенно  
 
Спасибо.

Здравствуйте!  
 
Помогите пожалуйста решить непростую для меня задачу:  
Есть таблица с данными (лист database), есть вторая таблица (лист Gather). В обоих таблицах есть общий параметр (номер).  
Так необходимо сделать чтобы данные со второй таблицы попали в нужную строчку первой таблицы (лист Надо). Надеюсь правильно объяснил. Файл во вложении  
 
Примерно такие темы уже были, внимательно изучив их я позаимствовал код с перебором, немного "переделав под себя", но нижеследующий код (его тоже увидел на страницах этого замечательного форума)обещает быть "быстрым"  т.к. мне надо обработать 9 таблиц с примерно 550000 записями в каждом!!!. Мой код как понимаете работает оччччччень медленно.  
 
Помогите разобраться с этим кодом . Я ничего не понял.    
 
Sub подстановка()  
Dim mycol As New Collection  
 
' столбец 1 поле ФИО  
' столбец 4 табельный номер ФИО в справочнике  
' столбец 5 ФИО в справочнике  
' в столбец 2 подставляем табельный номер  
 
ii = 5 '  
 
rf1 = WorksheetFunction.CountA(Columns(ii))  
rf2 = ActiveSheet.UsedRange.Rows.Count  
 
arr = Range(Cells(1, 1), Cells(rf2, ii))  
 
On Error Resume Next  
For i = 2 To rf1  
mycol.Add arr(i, ii - 1), CStr(arr(i, ii)) ' загрузка справочника  
Next  
On Error GoTo 0  
 
ReDim tarr(1000000, 1) ' результирующий массив  
On Error Resume Next  
For i = 2 To rf2  
tarr(i, 1) = mycol.Item(arr(i, 1))  
Next  
On Error GoTo 0  
 
Range(Cells(1, 2), Cells(rf2, 2)) = tarr()  
End Sub  
 
'подстановка значений в списке 800 тыс. из справочника объемом 800 тыс. записей делается менее 1 секунды  
 
Спасибо заранее!!!