Есть несколько столбцов с 744 или 720 (Количество часов в месяце) строками подряд, без пробелов. Нужен макрос, который бы при запуске предлагал выделить нужные столбцы и делил каждый целый столбец на 31 или 30 столбцов по 24 строки на новый лист. То есть 31 или 30 дней по 24 часа.
И нужен макрос, делающий обратно. Из одной матрицы в один столбик
Ігор Гончаренко, с языка снял Но потом подумал и кажется возможно (правильно?) понял, что кол-во дней неважно, ТС-у нужно цикл по 24, потом новый столбец на листе с результатом и т.д. Непонятно только - за исходные брать один столбец или несколько
Sub mrshkei()
Dim i As Long, z As Long, n As Long, arr, arr2, rng As Range, x As Long, result As Range
Set rng = Application.InputBox("Выберите данные", Type:=8)
x = Application.InputBox("Укажите количество дней в месяце", Type:=1)
Set result = Application.InputBox("Укажите 1 ячейку куда вывести результат", Type:=8)
arr = rng
ReDim arr2(1 To 24, 1 To x)
i = 1
For z = 1 To 24
For n = 1 To x
arr2(z, n) = arr(i, 1)
i = i + 1
Next n
Next z
result.Resize(UBound(arr2), x) = arr2
End Sub
_Igor_61, все верно, если в феврале 28 дней, то столбец будет состоять из 28*24=672 строк, и на лист с результатом, из этого одного столбца получится соответственно 28. Если 29 дней то 29. и т.д.
Цитата
_Igor_61 написал: Непонятно только - за исходные брать один столбец или несколько
За исходные хотелось бы иметь возможность несколько столбцов. Один столбец должен соответствовать одному результату. Если столбца 2, то нужно чтобы создалось два листа, каждый из которых будет содержать матрицу соответствующую своему столбцу.
Mershik, спасибо! А можно как то обойтись без указания количества дней? Чтобы к примеру если в месяце 30 дней, т.е 720 часов, следующие 24 часа добавлялся столбец с нулями?
Артем Колчин, а как по данным понять какой мксяц? может так?
Код
Sub mrshkei()
Dim i As Long, z As Long, n As Long, arr, arr2, rng As Range, x As Long, result As Range
Set rng = Application.InputBox("Выберите данные", Type:=8)
x = rng.Cells.Count / 24
Set result = Application.InputBox("Укажите 1 ячейку куда вывести результат", Type:=8)
arr = rng
ReDim arr2(1 To 24, 1 To x)
i = 1
For z = 1 To 24
For n = 1 To x
arr2(z, n) = arr(i, 1)
i = i + 1
Next n
Next z
result.Resize(UBound(arr2), x) = arr2
End Sub