Всем привет! Подскажите кто знает как разрешить ситуацию. Есть условная таблица из 4 листов (их может быть множество). На 1 листе ячейка А1 заполняется вручную, там дата прибытия товара на склад. Требуется чтобы при изменении этой даты на необходимую, автоматически формировался диапазон выделенный серым цветом на листе 1 (он так же показан условно). На листе 2,3,4 вся выборка прихода товара. Тоесть если на листе А1 выбираю дату 11.08.2017, то автоматически появляется время прибытия, наименование сорта и позиции с оставшихся листов именно за эту дату (как это указано в примере зеленым цветом). Желательно чтоб это еще было в порядке возрастания времени поступления. Если выбирая 12.08.2017, то в сером диапазоне появлялись товары 12 августа и тд. Если кто может подсказать как это сделать без макроса формулами было бы отлично., так как количество листов со временем будет увеличиваться. Пытался это прописать сам через поиск позиций, но ничего не получилось... Заранее благодарю за помощь!
Всем привет! Подскажите кто знает как разрешить ситуацию. Есть условная таблица из 4 листов (их может быть множество). На 1 листе ячейка А1 заполняется вручную, там дата прибытия товара на склад. Требуется чтобы при изменении этой даты на необходимую, автоматически формировался диапазон выделенный серым цветом на листе 1 (он так же показан условно). На листе 2,3,4 вся выборка прихода товара. Тоесть если на листе А1 выбираю дату 11.08.2017, то автоматически появляется время прибытия, наименование сорта и позиции с оставшихся листов именно за эту дату (как это указано в примере зеленым цветом). Желательно чтоб это еще было в порядке возрастания времени поступления. Если выбирая 12.08.2017, то в сером диапазоне появлялись товары 12 августа и тд. Если кто может подсказать как это сделать без макроса формулами было бы отлично., так как количество листов со временем будет увеличиваться. Пытался это прописать сам через поиск позиций, но ничего не получилось... Заранее благодарю за помощь!Nik57
Да, вариант такой просматривается, только есть три но))
1. выборка идет только с одного листа 2, а не всех листов 2. если меняется число, которого нет в таблице, то выскакивает ошибка как "ЧИСЛО", а необходимо чтоб в таких случаях были пустые ячейки 3. и время не в порядке возрастания.
возможно это все кажется как мелочи, просто когда в таблице будет порядка 200 позиций, будет крайне неудобно выбирать числа в порядке возрастания вручную
Да, вариант такой просматривается, только есть три но))
1. выборка идет только с одного листа 2, а не всех листов 2. если меняется число, которого нет в таблице, то выскакивает ошибка как "ЧИСЛО", а необходимо чтоб в таких случаях были пустые ячейки 3. и время не в порядке возрастания.
возможно это все кажется как мелочи, просто когда в таблице будет порядка 200 позиций, будет крайне неудобно выбирать числа в порядке возрастания вручнуюNik57
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("A1").CurrentRegion.Value: k = 0 ReDim y(1 To UBound(x), 1 To 4)
For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 4).Value = y() End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
[/vba]
вариант:
[vba]
Код
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("A1").CurrentRegion.Value: k = 0 ReDim y(1 To UBound(x), 1 To 4)
For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 4).Value = y() End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
nilem, подскажите, пожалуйста (я просто в макросах не соображаю) а как макрос изменится, к примеру, в такой ситуации как в прикрепленном примере? Дело в том что количество листов и диапазон будет меняться в таблице, чтоб я мог провести аналогию между двумя вашими макросами и понять цепочку?
nilem, подскажите, пожалуйста (я просто в макросах не соображаю) а как макрос изменится, к примеру, в такой ситуации как в прикрепленном примере? Дело в том что количество листов и диапазон будет меняться в таблице, чтоб я мог провести аналогию между двумя вашими макросами и понять цепочку?Nik57
nilem, вот такой еще вопросик, по старым следам. Появилась необходимость добавить дополнительные листы. Проблема в том, при наличии листа под именем лист1; макрос перестает работать (точнее он не формирует в порядке возрастания). стоит его удалить, все работает. Как возможно исправить этот дефект? Кнопку макроса забыл вытащить, прошу прощения)
nilem, вот такой еще вопросик, по старым следам. Появилась необходимость добавить дополнительные листы. Проблема в том, при наличии листа под именем лист1; макрос перестает работать (точнее он не формирует в порядке возрастания). стоит его удалить, все работает. Как возможно исправить этот дефект? Кнопку макроса забыл вытащить, прошу прощения)Nik57
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 4) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) End If Next i End If If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 4).Value = y() End If Next wsh
[/vba]
как-то так должно быть[vba]
Код
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 4) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) End If Next i End If If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 4).Value = y() End If Next wsh
krosav4ig, работает опять некорректно. При использовании макроса выглядит вот так. Диапазоны из листов повторяются несколько раз в диапазоне B:Е листа "отчет"
krosav4ig, работает опять некорректно. При использовании макроса выглядит вот так. Диапазоны из листов повторяются несколько раз в диапазоне B:Е листа "отчет"Nik57
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 5) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) y(k, 5) = wsh.Name End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 5).Value = y() End If End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
[/vba]
Упс, одна строчка не туда затесалась [vba]
Код
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Range("A1").CurrentRegion.Offset(1).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 5) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) y(k, 5) = wsh.Name End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 5).Value = y() End If End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
krosav4ig, а если за пределом столбца F встречаются константы или формулы, то их макрос "сшибает". Как сделать чтоб макрос работал только в диапазоне A:F?
krosav4ig, а если за пределом столбца F встречаются константы или формулы, то их макрос "сшибает". Как сделать чтоб макрос работал только в диапазоне A:F?Nik57
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Intersect(ActiveSheet.UsedRange.Offset(1), [B:F]).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 5) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) y(k, 5) = wsh.Name End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 5).Value = y() End If End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
[/vba]
[vba]
Код
Option Explicit
Sub ertert() Dim wsh As Worksheet, dt As Date, x, y(), i&, k& dt = Range("A1").Value Intersect(ActiveSheet.UsedRange.Offset(1), [B:F]).ClearContents
For Each wsh In ThisWorkbook.Sheets If Not wsh Is ActiveSheet Then x = wsh.Range("I1").CurrentRegion.Value If Not IsEmpty(x) Then k = 0 ReDim y(1 To UBound(x), 1 To 5) For i = 1 To UBound(x) Step 2 If x(i, 1) = dt Then k = k + 1 y(k, 1) = dt y(k, 2) = x(i + 1, 1) y(k, 3) = x(i, 2) y(k, 4) = x(i + 1, 2) y(k, 5) = wsh.Name End If Next i If k > 0 Then Cells(Rows.Count, 2).End(xlUp)(2, 1).Resize(k, 5).Value = y() End If End If Next wsh
With Range("B1:F" & Cells(Rows.Count, 2).End(xlUp).Row) .Sort Key1:=.Cells(1, 1), Order1:=xlAscending, _ Key2:=.Cells(1, 2), Order2:=xlAscending, Header:=xlYes End With End Sub
krosav4ig, а возможно технически сделать так, чтобы можно было использовать один макрос под несколько дат, к примеру в таком виде как в приложенном файле? тоесть при его использовании диапазон B2:Е36 формировался в порядке увеличения по датам от 12 до 18 августа.
в примере дат шесть, но по факту может использоваться как одна дата, так шесть
krosav4ig, а возможно технически сделать так, чтобы можно было использовать один макрос под несколько дат, к примеру в таком виде как в приложенном файле? тоесть при его использовании диапазон B2:Е36 формировался в порядке увеличения по датам от 12 до 18 августа.
в примере дат шесть, но по факту может использоваться как одна дата, так шестьNik57
Вход
Регистрация
Напомнить пароль
Автосумма
Часто используемые
ВПР
ЕСЛИ
СУММЕСЛИ
Финансовые
Логические
Текстовые
Даты и времени 
Ссылки и массивы 
Математические
Другие функции
Проверка свойств и значений
Баз данных
Математические
Обработки массивов
Обработки строк
Преобразования типов данных 
Загрузки данных
Работы с файлами
Обработки системных параметров
Обработки цвета
Работы с датами и временем
Преобразования в системы счисления
Финансовые
