Создание накладной по прайсу

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Мир MS Excel » Вопросы и решения » Вопросы по VBA » Создание накладной по прайсу (Макросы/Sub)

Grom87

Дата: Пятница, 15.05.2015, 21:25 | Сообщение № 1

Группа: Пользователи

Ранг: Прохожий

Сообщений: 3

Репутация: 0 ±

Замечаний: 0% ±

Excel 2007

Здравствуйте, столкнулся с аналогичной ситуацией как описано http://www.excelworld.ru/forum/2-2908-1#144333. Пытался сам исправить, по предложенному шаблону в VBA, но за неимением знаний, в данной сфере, ничего не выходит

В отличие, от данного варианта, у меня дополнительный столбик с "ед.изм.". Буду очень признателен, если есть пошаговая инструкция с объяснением или видеоматериал по данному решению. Если предложите готовое решение, буду признателен

К сообщению приложен файл: 6234035.xlsm (70.9 Kb)

Ответить

Manyasha

Дата: Пятница, 15.05.2015, 22:16 | Сообщение № 2

Группа: Модераторы

Ранг: Старожил

Сообщений: 2198

Репутация: 898 ±

Замечаний: 0% ±

Excel 2010, 2016

Grom87, здравствуйте. За основу взяла макрос из предложенной Вами темы. Поправила совсем чуть-чуть под Вашу таблицу:

[vba]

Код

Private Sub Worksheet_Change(ByVal Target As Range)
     Dim Mas As Range
     Dim i As Long, ii As Long: ii = 8
     Set nkl = Sheets("НАКЛАДНАЯ"): Set prs = Sheets("ПРАЙС")
     If Not Intersect(prs.Range("C3:C" & prs.Range("A1").End(xlDown).Row), Target) Is Nothing Then
         With Application
             .EnableEvents = False
             .ScreenUpdating = False
         End With
         nkl.Range("A9:f" & nkl.Range("f9").End(xlDown).Row).Clear
         For i = 3 To prs.Range("A1").End(xlDown).Row
             If prs.Range("C" & i) <> "" Then
                 prs.Range("e" & i) = prs.Range("C" & i) * prs.Range("d" & i)
                 ii = ii + 1
                 nkl.Range("A" & ii) = ii - 8 ' №
                 nkl.Range("B" & ii) = Trim(prs.Range("A" & i))
                 nkl.Range("C" & ii) = prs.Range("B" & i)
                 nkl.Range("D" & ii) = prs.Range("C" & i)
                 nkl.Range("E" & ii) = prs.Range("D" & i)
                 nkl.Range("F" & ii) = prs.Range("E" & i)
                 nkl.Range("A" & ii).HorizontalAlignment = xlCenter
                 iSum = iSum + nkl.Range("E" & ii)
             Else: prs.Range("e" & i) = ""
             End If
         Next i
         nkl.Range("E" & ii + 2) = iSum
         nkl.Range("D" & ii + 2) = "Итого"
         nkl.Range("E" & ii + 2).Font.Bold = True
         nkl.Range("D" & ii + 2).Font.Bold = True
         Set Mas = nkl.Range("A9:f" & nkl.Range("E9").End(xlDown).Row)
         Mas.Borders(xlDiagonalDown).LineStyle = xlNone
         Mas.Borders(xlDiagonalUp).LineStyle = xlNone
         With Mas.Borders(xlEdgeLeft)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Mas.Borders(xlEdgeTop)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Mas.Borders(xlEdgeBottom)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Mas.Borders(xlEdgeRight)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Mas.Borders(xlInsideVertical)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Mas.Borders(xlInsideHorizontal)
             .LineStyle = xlContinuous
             .Weight = xlThin
             .ColorIndex = xlAutomatic
         End With
         With Application
             .EnableEvents = True
             .ScreenUpdating = True
         End With
     End If
End Sub

[/vba]

Накладная формируется при изменении листа ПРАЙС.

[vba]

Код