Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти  
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Заполнение таблицы данными с заведомо известным максимальным количеством строк
 
#1
9 янв 2021 10:03:27
Доброго времени суток!
HELP.
Имеется столбец с данными - (O6:О), которыми необходимо заполнить таблицу.
Максимальное количество строк в таблице пользователь задаёт вручную - (P6)
Изменено: ГДВ - 13 янв 2021 04:33:31
 
 
 
#2
12 янв 2021 20:51:06
Есть на форуме, что-то похожее, но с другим подходом.
 
 
 
#3
13 янв 2021 09:45:13
В первом приближении макрос
Код
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
 
 
 
#4
13 янв 2021 17:29:25
Kuzmich благодарю за отклик и первое приближение!

Что касаемо макроса, если менять максимальное количество строк, то работает только со следующими максимальными значениями строк:
2; 7-11; 13; 14; 17; 20. Это если в столбце остаётся количество значений - 97.
На все остальные случаи максимального количества строк выдаёт ошибку - run time error '6': overflow. В макросе выделяет строчку №12: k = k + 1
Ради интереса попробовал в столбец данные внести ещё три значения - 100 и выставить "максимальное количество строк" - 12. Уже такой ошибки не встречается, как это было при - 97.
 
 
 
#5
13 янв 2021 18:40:46
ГДВ,
Попробуйте такой вариант
Код
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
 
 
 
Страницы: 1
Читают тему (гостей: 1)
Наверх