Страницы: 1
RSS
Копирование данных в добавленные строки по критерию с помощью макроса
 
Доброго времени суток, уважаемые форумчане! Пожалуйста, помогите мне с данным вопросом:

Надо чтобы макрос добавлял количество строк, определенное  значением ячейки (M14) - 1, либо сразу брал значение из ячейки N14 (разницы в принципе нет).
В данном случае он должен добавить 8 строк над или под строкой 5, и перенося на  ячейки добавленных строк формат ячеек из строки 5.

Буду очень благодарен за любую информацию которая поможет разобраться с этим вопросом. За ранее спасибо!
 
Grisha777999,
Возможно вам нужна не Вставка определенного кол-ва строк с помощью макроса VBA,
а копирование строк с листа "данные" между двумя датами?
 
Да абсолютно верно, но я думал это уже следующий шаг, тоесть сначала добавим строки=>потом заполняем данными. Или тут можно по другому обыграть, запустить цикл добавления строки и сразу заполнение ее данными и так пока данные ,что между двумя датами не закончатся?
 
Grisha777999,
даты от и до перенесите в M2 (01.01.2020) и N2 (31.01.2020)
Макрос в модуль листа "отчет", срабатывает при изменении дат.
В первом приближении, надо будет еще кое-что доделать. Попробуйте сами.
Код
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("M2:N2")) Is Nothing Then
  Application.EnableEvents = False
 Dim FirstDay As Date
 Dim EndDay As Date
 Dim iLastRow As Long
 Dim Rng As Range
 Dim n As Integer
  FirstDay = Range("M2")
     EndDay = Range("N2")
  With Worksheets("данные")
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("A1:M" & iLastRow)
      If Not .AutoFilterMode Then    'проверяем установлен Автофильтр на листе или нет
         Rng.AutoFilter              'устанавливаем автофильтр на столбцы таблицы
      Else
         If .FilterMode = True Then .ShowAllData 'если Автофильтр применён, то снимаем все фильтры
      End If
    .Range("A1:M" & iLastRow).AutoFilter Field:=4, Criteria1:= _
         ">=" & CDbl(FirstDay), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDay)
         n = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows.Count
     Rows(5).Resize(n - 1).Insert
     Range("B5") = 1
     Range("B5:B" & 4 + n).DataSeries
    .AutoFilter.Range.Columns(2).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("C5")
    .AutoFilter.Range.Columns(5).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("D5")
    .AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("E5")
    .AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("F5")
    '
    .AutoFilter.Range.AutoFilter
  End With
End If
  Application.EnableEvents = True
End Sub
 
Ох спасибо вам большое Kuzmich!  
 
Grisha,
На листе "отчет" в колонки ЕД.измер. и Количество откуда брать значения?
В "ИТОГО принято и отгружено продукции за отчетный месяц на сумму:" вы имеете ввиду сумму по столбцу J ?
Изменено: Kuzmich - 22.01.2020 13:18:51
 
Чтоже вы Grisha777999,
были на форуме и не ответили на мои вопросы. Кому надо решить вашу проблему?
 
Прошу прощения Kuzmich! У меня не было доступу к файлу чтобы посмотреть и дать точный ответ поэтому я решил отложить, виноват конечно, что вас не предупредил. Вообщем колонка количество берет значения из колонки I2:I10 на листе "данные" , а ЕД.измер. из I1 которая должна называться просто "кг" а где итого сумма (I5+I6....) и ( J5+J6...)

Создал для наглядности третий лист с результатом к которому стремлюсь.
 
Grisha777999,
Проверяйте
Скрытый текст
 
выходит ошибка :
Цитата
run time error '9'
Subscript out of range
Debug показывает на строчку 38
 
Нет такого диапазона.... Чему равно n? Возможно, в .Range("I1") нет пробела.
Ошибку нужно показывать в файле.
 
Grisha777999,
Цитата
Debug показывает на строчку 38
у вас в первом примере в ячейке I1 было "оттгруженно кг", а во втором просто кг
Фрагмент кода = Split(.Range("I1"), " ")(1) вытаскивал кг для первого случая.
Для второго случая напишите = .Range("I1")
 
Все работает если скопировать и вставить две даты в ячейки M2 и N2, а если вбивать по одной ячейке то он  после ввода одной, начинает sub, но это мелочи. Вы уже очень сильно мне помогли,  Спасибо огромное!  
 
Приветствую Уважаемые! Вообщем я доработал код , но не могу решить загадку с фрагментом кода который мне подсказали выше.
Если вбивать даты 01.01.2020 - 31.01.2020 то все работает, но как только поставить другой месяц , то:
Код
.AutoFilter.Range.Columns(x).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("x") 
- то копирует видимый диапазон упуская первую строку, то есть что он пропускает не только шапку  но и следующую строку которая должна быть скопирована.
Бьюсь как рыба об лёд не могу решить проблему, буду очень благодарен любой помощи и предложениям.
Вот фрагмент кода:
А так же файл в котором он применяется
Код
Sub sozdat_otchet()
Dim FirstDay As Date
Dim EndDay As Date
Dim i As Integer
Dim iLastRow As Long
Dim Rng As Range
Dim n As Integer
Dim ItogoRow As Integer 
   ItogoRow = Columns(2).Find("ИТОГО", , xlValues, xlPart).Row
   If ItogoRow > 7 Then
     Rows(6 & ":" & ItogoRow - 1).Delete
   End If

 Range("B5:J5,J6,I6,H6").Select
    Range("H6").Activate
    Selection.ClearContents
  FirstDay = Range("M2")
     EndDay = Range("N2")
  With Worksheets("данные")
    iLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
    Set Rng = .Range("A1:L" & iLastRow)
'    Rng.AutoFilter
'    Rng.AutoFilter
      If Not .AutoFilterMode Then    'проверяем установлен Автофильтр на листе или нет
         Rng.AutoFilter              'устанавливаем автофильтр на столбцы таблицы
      Else
         If .FilterMode = True Then .ShowAllData 'если Автофильтр применён, то снимаем все фильтры
      End If

    .Range("A1:L" & iLastRow).AutoFilter Field:=5, Criteria1:= _
    ">=" & CDbl(FirstDay), Operator:=xlAnd, Criteria2:="<=" & CDbl(EndDay)
         n = .AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Rows.Count 'считаем кол-во отфильтрованных строк без учета заголовка

     Rows(5).Resize(n - 1).Insert

    .AutoFilter.Range.Columns(2).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("C5") 'копируем столбец без учета заголовка
    .AutoFilter.Range.Columns(3).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("D5")
    .AutoFilter.Range.Columns(4).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("E5")
    .AutoFilter.Range.Columns(6).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("F5")
    .AutoFilter.Range.Columns(9).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("J5")
    .AutoFilter.Range.Columns(7).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("G5")
    .AutoFilter.Range.Columns(10).SpecialCells(xlCellTypeVisible).Offset(1).Copy Range("I5")
    Range("H5:H" & n + 4) = Split(.Range("J1"), " ")(1)

    For i = 5 To 5 + n - 1    'Номер счета-фактуры  дата и паспорт + дата
      Cells(i, "G") = "№ " & Cells(i, "G") & " от " & .AutoFilter.Range.Columns(.SpecialCells(xlCellTypeVisible).Offset(1).Cells(i - 4)
      Cells(i, "E") = "№ " & Cells(i, "E") & " от " & .AutoFilter.Range.Columns(5).SpecialCells(xlCellTypeVisible).Offset(1).Cells(i - 4)
    Next

    ItogoRow = Columns(2).Find("ИТОГО", , xlValues, xlPart).Row
    Cells(ItogoRow, "I") = WorksheetFunction.Sum(Range("I5:I" & ItogoRow - 1))
    Cells(ItogoRow, "J") = WorksheetFunction.Sum(Range("J5:J" & ItogoRow - 1))
    Range("B5:J" & ItogoRow - 1).Borders.Weight = xlThin
    .AutoFilter.Range.AutoFilter
  End With
End Sub
Изменено: Grisha777999 - 09.02.2020 19:34:32
 
Попробуйте
Код
AutoFilter.Range.Offset(1).SpecialCells(xlCellTypeVisible).Columns(2).Copy Range("C5") 

дальше аналогично
 
Ох Kuzmich вы меня снова спасли!) Огромное спасибо и всех благ!)
Страницы: 1
Наверх