Доброго времени суток! HELP. Имеется столбец с данными - (O6:О), которыми необходимо заполнить таблицу. Максимальное количество строк в таблице пользователь задаёт вручную - (P6)
Sub Tablica()
Dim i As Long
Dim j As Integer
Dim iLastRow As Long
Dim iCol As Integer 'количество необходимых столбцов
Dim k As Integer 'кол-во столбцов с Range("P6")
iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
iCol = WorksheetFunction.RoundUp((iLastRow - 5) / Range("P6"), 0)
Range(Cells(4, 1), Cells(3 + Range("P6"), iCol)).ClearContents
k = 0
Do
k = k + 1
Loop While k * Range("P6") + (iCol - k) * (Range("P6") - 1) <> iLastRow - 5 Or k > iCol - 1
j = 1
For i = 6 To k * Range("P6") + 5 Step Range("P6")
Range(Cells(i, "O"), Cells(i + Range("P6") - 1, "O")).Copy Cells(4, j)
j = j + 1
Next
For i = k * Range("P6") + 6 To iLastRow - 5 Step Range("P6") - 1
Range(Cells(i, "O"), Cells(i + Range("P6") - 2, "O")).Copy Cells(4, j)
j = j + 1
Next
End Sub
Что касаемо макроса, если менять максимальное количество строк, то работает только со следующими максимальными значениями строк: 2; 7-11; 13; 14; 17; 20. Это если в столбце остаётся количество значений - 97. На все остальные случаи максимального количества строк выдаёт ошибку - run time error '6': overflow. В макросе выделяет строчку №12: k = k + 1 Ради интереса попробовал в столбец данные внести ещё три значения - 100 и выставить "максимальное количество строк" - 12. Уже такой ошибки не встречается, как это было при - 97.
Sub Tablica()
Dim i As Long
Dim j As Integer
Dim n As Integer
Dim iLastRow As Long
Dim iCol As Integer 'количество необходимых столбцов
Dim k As Integer 'кол-во столбцов с Range("P6")
Dim iLR As Long
Dim iLastCol As Integer
iLR = Cells(Rows.Count, "A").End(xlUp).Row
iLastCol = Cells(4, Columns.Count).End(xlToLeft).Column
Range(Cells(4, 1), Cells(iLR, iLastCol)).ClearContents
iLastRow = Cells(Rows.Count, "O").End(xlUp).Row
iCol = WorksheetFunction.RoundUp((iLastRow - 5) / Range("P6"), 0)
If iCol >= 15 Then MsgBox "При таком количестве строк данные будут затерты": Exit Sub
For n = Range("P6") - 1 To 1 Step -1
k = 0
Do
k = k + 1
Loop While k * Range("P6") + (iCol - k) * n <> iLastRow - 5 And k < iCol
If k * Range("P6") + (iCol - k) * n = iLastRow - 5 Then Exit For
Next
j = 1
For i = 6 To k * Range("P6") + 5 Step Range("P6")
Range(Cells(i, "O"), Cells(i + Range("P6") - 1, "O")).Copy Cells(4, j)
j = j + 1
Next
For i = k * Range("P6") + 6 To iLastRow Step n
Range(Cells(i, "O"), Cells(i + n - 1, "O")).Copy Cells(4, j)
j = j + 1
Next
End Sub