Страницы: 1
RSS
Добавление пустых строк через число заданное в ячейке
 
Здравствуйте, не знаю как правильно объяснить, так что расскажу порядок своих действий по которому необходим макрос. В столбце А нахожу ячейку с двоеточием, складываю два числа в ней, допустим в ней 2:5, получаю 7, вычитаю из 9 (число постоянно) 7, полученные ранее, получаю 2. От этой ячейки с двоеточием отступаю 7 ячеек вниз и добавляю 2 пустые строки. Потом отсчитываю еще 5 ячеек (их тоже всегда 5) плюс еще 7 ячеек и опять добавляю 2 пустые строки. После этого выделяю все 37 ячеек (их всегда в итоге получается 37) и транспонирую в таблицу в виде строки. Таблица постоянно дополняется. Как-то это можно сделать макросом? В идеале, чтобы оно еще и удаляло все из столбца А. Помогите, пожалуйста. Формулами не смог добиться желаемого результата.
 
terpevt, пробуйте
Код
Sub Te()
Dim i&, j&, a$(), n&
  i = 3 'первая строка
  j = Cells(Rows.Count, 2).End(xlUp).Row 'последняя занятая строка
  Columns("F").NumberFormat = "@" 'текстовый формат для корректной вставки счета
  Do
    a = Split(Cells(i + 4, 1), ":")
    If UBound(a) <= 0 Then Stop 'сбой алгоритма
    n = 0 + a(0) + a(1)
    If n < 9 Then
      Cells(i + 5 + n, 1).Resize(9 - n).Insert xlDown
      Cells(i + 19 + n, 1).Resize(9 - n).Insert xlDown
    End If
    j = j + 1
    Cells(j, 2).Resize(, 37) = WorksheetFunction.Transpose(Cells(i, 1).Resize(37))
    i = i + 37
  Loop Until IsEmpty(Cells(i, 1))
  Columns(1).Clear
End Sub
 
Казанский, заработало!!! Заменил в 3 строке i = 3 тройку на номер своей строки и все сделалось. Спасибо! А можно сделать, чтобы я каждый раз не изменял макрос, а он сам находил нужный номер строки? Если нет, или Вам не охота, то я не обламаюсь и ставить его сам. Еще раз спасибо!
 
Казанский, в ходе обработки выяснилось, что не везде есть второй ряд ячеек, равный числу "n", (корорые заполнены целыми числами)  макрос из-за этого, естественно выдает ошибку. Мне приходится его изменять. Для n = 9
Код
Sub Te()
Dim i&, j&, a$(), n&
  i = 3 'первая строка
  j = Cells(Rows.Count, 2).End(xlUp).Row 'последняя занятая строка
  Columns("F").NumberFormat = "@" 'текстовый формат для корректной вставки счета
  Do
    a = Split(Cells(i + 4, 1), ":")
    If UBound(a) <= 0 Then Stop 'сбой алгоритма
    n = 0 + a(0) + a(1)
    If n = 9 Then
      Cells(i + 19, 1).Resize(9).Insert xlDown
    End If
    j = j + 1
    Cells(j, 2).Resize(, 37) = WorksheetFunction.Transpose(Cells(i, 1).Resize(37))
    i = i + 37
  Loop Until IsEmpty(Cells(i, 1))
  Columns(1).Clear
End Sub
можно это как-то запихать в ваш ммакрос и заставить применяться когда нет ячеек с большой буквой П.  
Изменено: terpevt - 12.12.2018 15:02:28
 
terpevt, можно
Код
Sub Te()
Dim i&, j&, a$(), n&
  i = 3 'первая строка
  j = Cells(Rows.Count, 2).End(xlUp).Row 'последняя занятая строка
  Columns("F").NumberFormat = "@" 'текстовый формат для корректной вставки счета
  Do
    a = Split(Cells(i + 4, 1), ":")
    If UBound(a) <= 0 Then Stop 'сбой алгоритма
    n = 0 + a(0) + a(1)
    If n < 9 Then
      Cells(i + 5 + n, 1).Resize(9 - n).Insert xlDown
      Cells(i + 19 + n, 1).Resize(9 - n).Insert xlDown
    ElseIf n = 9 Then
      Cells(i + 19, 1).Resize(9).Insert xlDown
    Else
      Stop 'n>9
    End If
    j = j + 1
    Cells(j, 2).Resize(, 37) = WorksheetFunction.Transpose(Cells(i, 1).Resize(37))
    i = i + 37
  Loop Until IsEmpty(Cells(i, 1))
  Columns(1).Clear
End Sub
Приложите файл с разными вариантами данных. Поиск нужного номера строки - позже.
 
Казанский, файл с тремя вариантами. Таблицу поставить справа не смог. На рабочем нубуке зависает Эксель когда больше 35 столбцов используется.
Страницы: 1
Наверх