Здравствуйте, столкнулся с аналогичной ситуацией как описано http://www.excelworld.ru/forum/2-2908-1#144333. Пытался сам исправить, по предложенному шаблону в VBA, но за неимением знаний, в данной сфере, ничего не выходит В отличие, от данного варианта, у меня дополнительный столбик с "ед.изм.". Буду очень признателен, если есть пошаговая инструкция с объяснением или видеоматериал по данному решению. Если предложите готовое решение, буду признателен
Здравствуйте, столкнулся с аналогичной ситуацией как описано http://www.excelworld.ru/forum/2-2908-1#144333. Пытался сам исправить, по предложенному шаблону в VBA, но за неимением знаний, в данной сфере, ничего не выходит В отличие, от данного варианта, у меня дополнительный столбик с "ед.изм.". Буду очень признателен, если есть пошаговая инструкция с объяснением или видеоматериал по данному решению. Если предложите готовое решение, буду признателен Grom87
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]
Накладная формируется при изменении листа ПРАЙС.
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]
Накладная формируется при изменении листа ПРАЙС.Manyasha