|
Заполнение накладных на изготовление деталей
|
|
| irakitin2014 | Дата: Суббота, 02.12.2017, 08:41 | Сообщение # 1 |
 Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| Вот моя первая тема:
Шеф поставил задачу облегчить заполнение и оформление накладных по отправке деталей на обработку в сторонние организации. Вот что я накропал, сообразуясь со своими пока очень малыми знаниями в VBA.
Алгоритм: В Листе Перечень при помощи комбобокса осуществляется поиск необходимых деталей( продуктов) направляемых на переработку( изготовление)в столбцах отправление или приход ставится количеств деталей на отправку или пришедших. Данное количество автоматически переносится соответственно на листы отправка или приход( формируется накладная), где по нажатии кнопки накладная сохраняется и распечатывается. Количество копий указывается в ячейке К1(зеленого цвета)
ВАЖНО: графа Примечание заполняется ДО заполнения граф отправка или приход
Код Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Application.CutCopyMode = False
Application.DisplayAlerts = False
Dim Lr As Long
Dim Lr1 As Long
Dim Lr2 As Long
Dim trw As Long
Dim trs As Long
If Target.Count > 1 Then Exit Sub
Lr = Sheets("Перечень").Cells(Rows.Count, 1).End(xlUp).Row
Lr1 = Sheets("Отправка").Cells(Rows.Count, 1).End(xlUp).Row
Lr2 = Sheets("Получение").Cells(Rows.Count, 1).End(xlUp).Row
If Intersect(Target, Range("E2:F" & Lr)) Is Nothing Then Exit Sub
trw = Target.Row
trs = Target.Column
If trs = 5 Then
If Range("E" & trw) = "" Then Exit Sub
Sheets("Перечень").Range("A" & trw & ":E" & trw & "," & "G" & trw).Copy
Sheets("Отправка").Range("A" & Lr1 + 1).PasteSpecial Paste:=xlPasteValues
Sheets("Отправка").Range("A" & Lr1 + 1 & ":F" & Lr1 + 1).Borders.LineStyle = xlContinuous
Sheets("Отправка").Rows(Lr1 + 2).Insert Shift:=xlDown
Else
If Range("F" & trw) = "" Then Exit Sub
Range("A" & trw & ":D" & trw & "," & "F" & trw & ":G" & trw).Copy
Sheets("Получение").Range("A" & Lr2 + 1).PasteSpecial Paste:=xlPasteValues
Sheets("Получение").Range("A" & Lr2 + 1 & ":F" & Lr2 + 1).Borders.LineStyle = xlContinuous
Sheets("Получение").Rows(Lr2 + 2).Insert Shift:=xlDown
End If
Application.ScreenUpdating = True
Application.CutCopyMode = True
Application.DisplayAlerts = True
End Sub
для спасибов ЯД 41001877306852
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 08:43 | Сообщение # 2 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| Все комментарии, критика и наставления на путь истинный приветствуются
для спасибов ЯД 41001877306852
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:36 | Сообщение # 3 |
 Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| Код If Target.Count > 1 Then Exit Sub
А обновление экрана включить? 
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 09:42 | Сообщение # 4 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| Дык вроде включено
поясни
для спасибов ЯД 41001877306852
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:42 | Сообщение # 5 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| С отступами беда, конечно. Надо как-то упорядочить их использование.
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:43 | Сообщение # 6 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| Цитата irakitin2014 (  ) Дык вроде включено
А после Exit sub тоже включится?
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 09:47 | Сообщение # 7 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| Цитата dsb75 ( ) А после Exit sub тоже включится?
опа, спасибо. век живи век учись
для спасибов ЯД 41001877306852
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:48 | Сообщение # 8 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| Но вообще вполне себе хороший код.
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 09:49 | Сообщение # 9 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| то есть после
Код If Target.Count > 1 Then Exit Sub
надо ставить
Код Application.DisplayAlerts = True
для спасибов ЯД 41001877306852
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:55 | Сообщение # 10 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| Цитата irakitin2014 ( ) то есть после ...
Ну не совсем, у вас там 4 выхода из обработчика в теле.
Скорее всего exit sub не использовать
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 09:57 | Сообщение # 11 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| А комбобокс когда становится не пустым? Я в отправку / приём цифры загнал, а он всё пустой... Он зачем вообще?
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 10:00 | Сообщение # 12 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| А ещё автофильтр стоит нехорошо на табличке - сортировка и количества перемешаются
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 10:00 | Сообщение # 13 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| в комбобоксе надо набрать например 1 или букву д ( к примеру) он для поиска детали. в реале в листе перечень в столбце А больше 5000 строк
для спасибов ЯД 41001877306852
|
| |
| |
| irakitin2014 | Дата: Суббота, 02.12.2017, 10:02 | Сообщение # 14 |
|
Генерал-майор
Группа: Модераторы
Сообщений: 312
Статус: Offline
| автофильтр тоже для удобства поиска: например найти все детали содержащиие цифру 1
для спасибов ЯД 41001877306852
|
| |
| |
| dsb75 | Дата: Суббота, 02.12.2017, 10:05 | Сообщение # 15 |
|
Генералиссимус
Группа: Администраторы
Сообщений: 133
Статус: Offline
| Цитата irakitin2014 ( ) автофильтр тоже для удобства
ну так распространите его не все столбцы
|
| |
| |
