По мне лучше убирать меню не при запуске файла, а при закрытии файла. Потому что это меню нужено именно для этого файла. А в других файлах можно использовать другое меню. Меню одного файла не мешает меню другого файла.

Тема закрыта

Спасибо, тема закрыта

Здравствуйте!  
В коде формы есть такие строки:  
 
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  
 
Возможно ли написать этот код сокращенно  
 
Спасибо.

Здравствуйте Hugo!  
 
СПАСИБО ВАМ! Вы спасли меня. Кстати я разобрался с кодом на 95%  
 
Отдельное СПАСИБО Создателю такого замечательного сайта!

Здравствуйте Hugo!  
 
Спасибо Вам за Ваше терпение.  
 
Сейчас я не на работе и у меня нет тех больших таблиц.  
 
По Вашему ответу я понял, что результирующиая таблица попадает в новую книгу. В ней содержится ПЕРВАЯ таблица в первоначальном виде, а рядом - соостветсвующие такому же "номеру" данные со ВТОРОЙ таблицы. Это ОЧЕНЬ ХОРОШО.  
 
Теперь. У меня ПЕРВАЯ таблица необязательно бОльшая. Есть файлы где почему-то сдали больше, чем выдали!!! (Это ошибки нескольких людей, которые забивали данные с 2007 года).    
 
Поэтому хотелось бы при выполнении кода (или отдельным кодом) выяснить ЛИШНИЕ строки ВТОРОЙ таблицы ("Gather"), которые не попали в Первую таблицу. Хоты бя отмечались в дополнительном столбце самой таблицы ("Gather").  
 
Надеюсь четко изложил суть задачи.    
Еще раз Спасибо Вам Hugo!

{quote}{login=Юрий М}{date=24.08.2011 01:27}{thema=Re: }{post}{quote}{login=nar}{date=24.08.2011 01:24}{thema=}{post}Можете закоментировать Ваш код - я попробую разобраться с помощью справок и google.{/post}{/quote}Может, прокомментировать? :-) Закомментировать - отключить строки{/post}{/quote}  
 
Теперь буду знать.  
 
Hugo, все отлично, я рад за код, большое вам спасибо, но появилась еще одна задача. Условия те же что и первой, но теперь надо чтобы во второй таблице оставались только те строки, которые не нашлись в первой таблице.  
Я и не думал, что это будет необходимо для дальнейшей реализации моего проекта.

Спасибо Hugo!  
 
Это вариант меня устраивает т.к. "обработку" 60970 строк выполнил за 8 секунд!!!  
Попробую на больших таблицах (550000 строк). А каждую таблицу я буду обрабатывать только по одному разу.  
 
Можете закоментировать Ваш код - я попробую разобраться с помощью справок и google.

{quote}{login=GIG_ant}{date=23.08.2011 11:35}{thema=}{post}или мне кажется, или в таблице надо перепутаны столбцы "Сдал" и "Номер акта сдачи"{/post}{/quote}  
 
Да, вы правы там перепутаны поля  
 
Файл делал на скорую руку

Здравствуйте!  
 
Помогите пожалуйста решить непростую для меня задачу:  
Есть таблица с данными (лист 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 секунды  
 
Спасибо заранее!!!