Создание первой простой обработки
Создадим аналог обработки. которую мы использовали для OOO в VBA (формирование отчета средняя серебристость комплексов). Ниже приведен полный код макроса с комментариями. Разбивка на подмодули, в отличие от ООО не проводилась, весь макрос заключен в одну программу. Код рассмотреть самостоятельно.
Sub Simple_Relise()
With Worksheets("Sheet1")
.Range("A1:AF65536").AutoFilter
.Range("A1:AF65536").AutoFilter Field:=4, Criteria1:="Столовая для персонала"
End With
'Вставляем новый лист после листа Sheet1
ActiveWorkbook.Worksheets.Add after:=Worksheets("Sheet1")
'Даем ему имя Торговый зал
Worksheets(2).Name = "Столовая для персонала"
'Копируем отфильтрованный диапазон в первую ячейку вставленного листа
Worksheets("Sheet1").Range("A1:AF65536").Copy Worksheets("Столовая для персонала").Range("A1")
'Чуть расширим макрос - теперь мы хотим удалить лист Sheet1 (или первый лист)
'Но так как он содержит данные. чтобы не получить лишних подтвержающих сообщений
'Отключим их следующей строчкой
Application.DisplayAlerts = False
'Теперь можно удалить лист
Worksheets(1).Delete
' Удаляем не нужные столбы
Worksheets("Столовая для персонала").Columns("A:A").Delete
Worksheets("Столовая для персонала").Columns("C:Z").Delete
Worksheets("Столовая для персонала").Columns("H:K").Delete
'Вводим в крайний правый пустой столбец сумму расчета НДС
Range("H2").Formula = "=(F2/C2)+D2"
' Протягиваем ее по кол-ву заполненных ячеек соседнего столбца
n = Sheets("Столовая для персонала").Range("G1").CurrentRegion.Rows.Count
Range("H2").AutoFill Destination:=Range("H2:H" & n), Type:=xlFillDefault
Range("H1") = "СтолСебсНДС"
' Вставляем формулы итогов под столбцы. Поскольку живые формулы нам не нужны, 'воспользуемся реализацией, выводящей только значения
s = Cells(Rows.Count, 3).End(xlUp).Row
Cells(s + 1, 3) = Application.WorksheetFunction.Sum(Range(Cells(2, 3), Cells(s, 3)))
s = Cells(Rows.Count, 4).End(xlUp).Row
Cells(s + 1, 5) = Application.WorksheetFunction.Sum(Range(Cells(2, 5), Cells(s, 5)))
Cells(s + 1, 4) = Cells(s + 1, 5) / Cells(s + 1, 3)
s = Cells(Rows.Count, 7).End(xlUp).Row
Cells(s + 1, 7) = Application.WorksheetFunction.Sum(Range(Cells(2, 7), Cells(s, 7)))
Cells(s + 1, 8) = Cells(s + 1, 7) / Cells(s + 1, 3)
' Выделим жирным шрифтом первый и последний столбец диапазона
Rows(1).Font.Bold = True
Rows(s + 1).Font.Bold = True
' Установим на весь диапазон числовой формат два знака после запятой
Worksheets(1).Range("A1:H" & n + 1).NumberFormat = "0.00"
' Установим границы ячеек для оформления таблицы
With Worksheets(1).Range("A1:H" & n + 1)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
' Применим автоширину столбцов
Columns("A:H").EntireColumn.AutoFit
'Сделаем проверку с выделением цвета на столбцу себестоимости
For i = s To 2 Step -1
text1 = Cells(i, 4).Value
If text1 > 38.14 Then
Cells(i, 4).Interior.Color = vbRed
End If
Next i
End Sub
Sub Simple_Relise()
With Worksheets("Sheet1")
.Range("A1:AF65536").AutoFilter
.Range("A1:AF65536").AutoFilter Field:=4, Criteria1:="Столовая для персонала"
End With
'Вставляем новый лист после листа Sheet1
ActiveWorkbook.Worksheets.Add after:=Worksheets("Sheet1")
'Даем ему имя Торговый зал
Worksheets(2).Name = "Столовая для персонала"
'Копируем отфильтрованный диапазон в первую ячейку вставленного листа
Worksheets("Sheet1").Range("A1:AF65536").Copy Worksheets("Столовая для персонала").Range("A1")
'Чуть расширим макрос - теперь мы хотим удалить лист Sheet1 (или первый лист)
'Но так как он содержит данные. чтобы не получить лишних подтвержающих сообщений
'Отключим их следующей строчкой
Application.DisplayAlerts = False
'Теперь можно удалить лист
Worksheets(1).Delete
' Удаляем не нужные столбы
Worksheets("Столовая для персонала").Columns("A:A").Delete
Worksheets("Столовая для персонала").Columns("C:Z").Delete
Worksheets("Столовая для персонала").Columns("H:K").Delete
'Вводим в крайний правый пустой столбец сумму расчета НДС
Range("H2").Formula = "=(F2/C2)+D2"
' Протягиваем ее по кол-ву заполненных ячеек соседнего столбца
n = Sheets("Столовая для персонала").Range("G1").CurrentRegion.Rows.Count
Range("H2").AutoFill Destination:=Range("H2:H" & n), Type:=xlFillDefault
Range("H1") = "СтолСебсНДС"
' Вставляем формулы итогов под столбцы. Поскольку живые формулы нам не нужны, 'воспользуемся реализацией, выводящей только значения
s = Cells(Rows.Count, 3).End(xlUp).Row
Cells(s + 1, 3) = Application.WorksheetFunction.Sum(Range(Cells(2, 3), Cells(s, 3)))
s = Cells(Rows.Count, 4).End(xlUp).Row
Cells(s + 1, 5) = Application.WorksheetFunction.Sum(Range(Cells(2, 5), Cells(s, 5)))
Cells(s + 1, 4) = Cells(s + 1, 5) / Cells(s + 1, 3)
s = Cells(Rows.Count, 7).End(xlUp).Row
Cells(s + 1, 7) = Application.WorksheetFunction.Sum(Range(Cells(2, 7), Cells(s, 7)))
Cells(s + 1, 8) = Cells(s + 1, 7) / Cells(s + 1, 3)
' Выделим жирным шрифтом первый и последний столбец диапазона
Rows(1).Font.Bold = True
Rows(s + 1).Font.Bold = True
' Установим на весь диапазон числовой формат два знака после запятой
Worksheets(1).Range("A1:H" & n + 1).NumberFormat = "0.00"
' Установим границы ячеек для оформления таблицы
With Worksheets(1).Range("A1:H" & n + 1)
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
End With
' Применим автоширину столбцов
Columns("A:H").EntireColumn.AutoFit
'Сделаем проверку с выделением цвета на столбцу себестоимости
For i = s To 2 Step -1
text1 = Cells(i, 4).Value
If text1 > 38.14 Then
Cells(i, 4).Interior.Color = vbRed
End If
Next i
End Sub
Комментарии
Отправить комментарий