Создание первой простой обработки

Создадим аналог обработки. которую мы использовали для 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












Комментарии

Популярные сообщения из этого блога

Запуск макросов в автоматическом режиме по расписанию

Пакетная обработка отчетов

Отправка отчетов по электронной почте