Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Добавить строку если достигнуто максимальное значение из определенного диапозона
 
Такая ситуация. Есть столбец с датами месяца. Некоторые даты могут отсутствовать. К примеру, 1.07.2018, 2.07.2018,08.07.2018, 11.07.2018 и тд. Нужно привести к определённому шаблону. Определить наибольшую дату до 10.07.2018 (т.е. первая декада) и вставить число пустых строк по значению разницы между 10 и получившимся наибольшим значением+1. Т.е. если максимальное значение в первой декаде 8.07.2018, то нужно вставить 3 пустые строки, в последнюю из  добавленных строк прописать "Итого за 1 декаду". Если значение 10.07.2018, то добавить 1 строку и написать в ней "итого за 1 декаду". И так с каждой декадой. Никак не могу сообразить как правильно это прописать. Я в vba совсем новичок, поэтому если есть возможность прописать с пояснениями, то буду очень благодарна. Помогите, пожалуйста
 
Цитата
Julia VK написал:
Помогите, пожалуйста
Вам чем помочь - общими рассуждениями или кодом? Если кодом, то приложите файл-пример (Правила, п.2.3).
 
Спасибо, исправилась. В файле 2 листа. Исходные данные и как должны эти данные выглядеть в идеале
 
Цитата
если максимальное значение в первой декаде 8.07.2018, то нужно вставить 3 пустые строки, в последнюю из  добавленных строк прописать "Итого за 1 декаду".
И где эти пустые строки в вашем примере?
 
Вот, поправила.  
 
То есть количество строк в декадах равно 10(11) (первая декада 10 строк, 2 декада 10 строк, 3 декада -11 строк на случай если в месяце 31 день) независимо от количества строк с данными
 
Julia VK, 4, 5, 7 в итогах - это сумма или счет?
То, что Вы выложили в #4 (без вставки строк), делается инструментом Данные - (структура) - Промежуточные итоги. Только надо добавить заголовок и столбец с формулой для определения декады
Код
=МИН(ОТБР((ДЕНЬ(A2)-1)/10)+1;3)
А потом ПромИтоги: при каждом изменении в С, операция Сумма (или Количество), добавить итоги по b, Конец страницы между группами, Итоги под данными.
Потом в режиме Страничный убрать разрыв страницы между 1 и 2 декадой.
 
Спасибо большое, но я видимо не правильно выразилась. Мне нужно прописать эту задачу именно с помощью макроса. У меня уже создан макрос, но застопорилась именно на вопросе добавления строк по декадам.
 
Цитата
уже создан макрос, но застопорилась именно на вопросе добавления строк по декадам.
И где же ваш макрос?
Вот посмотрите мой
Код
Sub Decada()
Dim i As Long
Dim iLastRow As Long
Dim iLastDay As Integer
Dim Dec_1 As Integer
Dim Dec_2 As Integer
Dim Dec_3 As Integer
Dim Rng As Range
Dim Sum_Month As Double
Dim n As Integer
 iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
      'последний день месяца из дат столбца А
   iLastDay = Day(DateSerial(Year(Cells(iLastRow, "A")), Month(Cells(iLastRow, "A")) + 1, 1) - 1)
      'определяем количество дат, входящих в каждую декаду
   Dec_1 = WorksheetFunction.CountIf(Range("A1:A" & iLastRow), _
                   "<" & CDbl(DateSerial(Year(Cells(iLastRow, "A")), Month(Cells(iLastRow, "A")), 11)))
   Dec_2 = WorksheetFunction.CountIf(Range("A1:A" & iLastRow), _
            "<" & CDbl(DateSerial(Year(Cells(iLastRow, "A")), Month(Cells(iLastRow, "A")), 21))) - Dec_1
   Dec_3 = iLastRow - Dec_1 - Dec_2
      'вставляем недостающие пустые строки, начиная снизу таблицы
   Rows(iLastRow - Dec_3 + 1).Resize(11 - Dec_2).Insert
   Rows(iLastRow - Dec_3 - Dec_2 + 1).Resize(11 - Dec_1).Insert
      iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
      n = 1
    For Each Rng In Range("B1:B" & iLastRow).SpecialCells(2, 1).Areas
      If n < 3 Then
        Rng.Cells(11, 0) = "Итого за " & n & " декаду : "
        Rng.Cells(11, 1) = WorksheetFunction.Sum(Rng)
      Else     'для 3 декады
        Rng.Cells(iLastDay - 19, 0) = "Итого за " & n & " декаду : "
        Rng.Cells(iLastDay - 19, 1) = WorksheetFunction.Sum(Rng)
      End If
       Sum_Month = Sum_Month + WorksheetFunction.Sum(Rng)
       n = n + 1
    Next
     iLastRow = Cells(Rows.Count, "A").End(xlUp).Row
     Cells(iLastRow + 1, 1) = "Итого за месяц: "
     Cells(iLastRow + 1, 2) = Sum_Month
End Sub
Вставку новой страницы сделайте сами. Удачи!
 
Julia VK, То есть на одном листе всегда один месяц? И да, что за странная фраза "оборотная сторона" после второй декады? Она вообще нужна?
 
Да в форме всегда 1 месяц. Это отчетный период. Формируется отчет, который распечатывается на 1 листе с двух сторон, поэтому и написано что оборотная сторона. Это бухгалтерская форма отчета.

Kuzmich,вы гений!! спасибо большое! Макрос у меня на работе, но там элементарный перенос данных из одной формы  в другую и изменение формата ячеек. Если бы вы увидели тот макрос, вы бы наверное долго над ним смеялись. Это был мой первый опыт)
 
Писала про разделение на страницы потому, что шапка таблицы сквозная и переносится на оборотную сторону
 
У меня покороче получилось...
Код
Sub InsStr()

   Dim i As Integer, j As Integer, dec1 As Integer, dec2 As Integer, dec3 As Integer
   
   Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = "итого за 3 декаду"
   Cells(Cells(Rows.Count, 1).End(xlUp).Row + 1, 1).Value = "итого за месяц"
   For i = Cells(Rows.Count, 1).End(xlUp).Row - 2 To 2 Step -1
      If Day(CDate(Cells(i - 1, 1).Value)) < 21 Then
         Rows(i).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         Cells(i, 1).Value = "итого за 2 декаду"
         Exit For
      End If
   Next i
   For j = i - 1 To 2 Step -1
      If Day(CDate(Cells(j - 1, 1).Value)) < 11 Then
         Rows(j).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
         Cells(j, 1).Value = "итого за 1 декаду"
         Exit For
      End If
   Next j
   dec1 = j
   dec2 = Columns(1).Find(what:="итого за 2 декаду", LookIn:=xlValues, lookat:=xlWhole).Row
   dec3 = Cells(Rows.Count, 1).End(xlUp).Row - 1
   Cells(dec1, 2).Value = WorksheetFunction.Sum(Range(Cells(2, 2), Cells(dec1 - 1, 2)))
   Cells(dec2, 2).Value = WorksheetFunction.Sum(Range(Cells(dec1 + 1, 2), Cells(dec2 - 1, 2)))
   Cells(dec3, 2).Value = WorksheetFunction.Sum(Range(Cells(dec2 + 1, 2), Cells(dec3 - 1, 2)))

End Sub
Изменено: StoTisteg - 31 Авг 2018 16:05:14
 
StoTisteg, А как быть со вставкой недостающих пустых строк в каждой декаде и с суммой за месяц?
 
Kuzmich, подскажите еще пожалуйста, не пойму что я делаю не так. Сегодня была на работе и посмотрела рабочий файл, который мне нужно доработать. В итоге получилось, что мне нужно не с 1ой строки начинать отсчет, а с 17 и по столбцу С. Суммы по столбцам F, I, J, K, L, V. W. Вопросы будут глупые, потому что я ни разу не программист
Цитата
Kuzmich написал:
 For Each Rng In Range("B1:B" & iLastRow).SpecialCells(2, 1).Areas
Что значат аргументы у specialCells?
Цитата
[USER=20]Kuzmich написал:
Rng.Cells(iLastDay - 19, 0) = "Итого за " & n & " декаду : "        Rng.Cells(iLastDay - 19, 1) = WorksheetFunction.Sum(Rng)
[/USER] 0 и 1 это столбцы? -19 это тоже с 0 отсчет?
Цитата
Kuzmich написал:
       Rng.Cells(11, 0) = "Итого за " & n & " декаду : "        Rng.Cells(11, 1) = WorksheetFunction.Sum(Rng)
11 это здесь значит через 11 строк ставить фразу "Итого...". Но если у меня начинается с 17 строки, то правильно ли я понимаю что итого за 1 декаду я должна ставить на 28 строке, по  2 декаде создать отдельный код с "Итого.." в 39 строке?
 
Цитата
Сегодня была на работе и посмотрела рабочий файл,
Даже в воскресенье человек работает. Если возможно, то выложите рабочий файл.
Цитата
Что значат аргументы у specialCells?
SpecialCells(2, 1) - числовые данные
Цитата
11 это здесь значит через 11 строк
Через 11 строк от начала диапазона Rng
 
"Анализ..." это исходные данные, "ФАУ-15.." - это куда мне нужно данные скопировать, но подекадно. Хочу в файле "Анализ" привести в вид в который мне надо, а потом данные скопировать в ФАУ-15. Скопировать данные проблем нет. Как разбить на декады вы мне помогли, а вот как начать с 17 строки не знаю, не могу понять где я допускаю ошибку, варианты разные перепробовала, но знаний нет и как применять разные функции vba не знаю
 
Цитата
не могу понять где я допускаю ошибку
Основная ошибка в определении Dec_3, поскольку диапазон начинается с 17 строки  
Код
Dec_3 = iLastRow - 16 - Dec_1 - Dec_2
И, мне кажется, цикла для определения строки с "Итого за 2 декаду:" не нужно, при ваших условиях это всегда строка 38
Код
Sub Decada()
Dim i As Long
Dim iLastRow As Long
Dim iLastDay As Integer
Dim Dec_1 As Integer
Dim Dec_2 As Integer
Dim Dec_3 As Integer
Dim Rng As Range
Dim Sum_Month As Double
Dim n As Integer
Dim y As Integer
 iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
      'последний день месяца из дат столбца С
  iLastDay = Day(DateSerial(Year(Cells(iLastRow, "C")), Month(Cells(iLastRow, "C")) + 1, 1) - 1)
      'определяем количество дат, входящих в каждую декаду
Dec_1 = WorksheetFunction.CountIf(Range("C17:C" & iLastRow), _
                 "<" & CDbl(DateSerial(Year(Cells(iLastRow, "C")), Month(Cells(iLastRow, "C")), 11)))
   Dec_2 = WorksheetFunction.CountIf(Range("C17:C" & iLastRow), _
         "<" & CDbl(DateSerial(Year(Cells(iLastRow, "C")), Month(Cells(iLastRow, "C")), 21))) - Dec_1
  Dec_3 = iLastRow - 16 - Dec_1 - Dec_2
      'вставляем недостающие пустые строки, начиная снизу таблицы
  Rows(iLastRow - Dec_3 + 1).Resize(11 - Dec_2).Insert
  Rows(iLastRow - Dec_3 - Dec_2 + 1).Resize(11 - Dec_1).Insert
   iLastRow = Cells(Rows.Count, "C").End(xlUp).Row
   n = 1
   For Each Rng In Range("F17:F" & iLastRow).SpecialCells(2, 1).Areas
If n < 3 Then
    Rng.Cells(11, 0) = "Итого за " & n & " декаду:"
    Rng.Cells(11, 1) = WorksheetFunction.Sum(Rng)
    Else     'для 3 декады
    Rng.Cells(iLastDay - 19, 0) = "Итого за " & n & " декаду:"
    Rng.Cells(iLastDay - 19, 1) = WorksheetFunction.Sum(Rng)
    End If
    Sum_Month = Sum_Month + WorksheetFunction.Sum(Rng)
     n = n + 1
   Next
    iLastRow = Cells(Rows.Count, "E").End(xlUp).Row
    Cells(iLastRow + 1, "E") = "Итого за месяц:"
    Cells(iLastRow + 1, "F") = Sum_Month
   For y = 17 To Cells(Rows.Count, "E").End(xlUp).Row - 1
     If Cells(y, "E") = "Итого за 2 декаду:" Then
      ActiveSheet.HPageBreaks.Add Before:=Cells(y + 1, "E")
     End If
   Next y
End Sub
Удачи!
 
Kuzmich,спасибо большое, добрый человек!!
 
Цитата
Суммы по столбцам F, I, J, K, L, V. W
Код
    Rng.Cells(11, 1) = WorksheetFunction.Sum(Rng)             'по F
    Rng.Cells(11, 4) = WorksheetFunction.Sum(Rng.Offset(, 3)) 'по I)
    Rng.Cells(11, 5) = WorksheetFunction.Sum(Rng.Offset(, 4)) 'по J)
далее аналогично
 
Цитата
Kuzmich написал:
как быть со вставкой недостающих пустых строк в каждой декаде и с суммой за месяц?
А в примере этого нет.
 
Kuzmich,спасибо ещё раз!!  
 
Цитата
StoTisteg написал:
А в примере этого нет
Действительно я в начале поторопилась, на телефоне быстренько файл напечатала и про эти строки забыла. Потом после замечания исправилась и прикрепила нужный файл.
Вам тоже спасибо большое за труд! Вообще не ожидала, что кто-нибудь ответит, а тут сразу 2 решения предложили!  
Страницы: 1
Читают тему (гостей: 1)
Наверх