Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Добавление в массив разных по длине строк
 
Добрый день!
Помогите, пжл-та, написать макрос добавления строк в разных местах массива, т.к. они могут были разными по длине.
Вложил файл, я думаю так будет понятнее, что нужно.
Спасибо заранее за помощь!
 
ArturioGattiii, перед запуском макроса надо выделить любую ячейку в столбце Признак 1.
Код
Sub bb()
Dim i&, c&
  c = ActiveCell.Column
  For i = Cells(Rows.Count, c).End(xlUp).Row To 2 Step -1
    If Not IsNumeric(Cells(i, c)) Then Exit For
    If Cells(i, c) <> Cells(i - 1, c) Then
      Cells(i, c).Resize(2, 2).Insert xlDown, xlFormatFromRightOrBelow
      Cells(i, c).Resize(2).Value = Cells(i + 2, c)
      With Cells(i, c + 1).Resize(2)
        .Value = [{"группа 1";"группа 2"}]
        .Interior.Color = vbYellow
      End With
    End If
  Next
End Sub
 
Код
Sub mas()
Dim mass()
For i = 5 To Cells(Rows.Count, 4).End(xlUp).Row
    If Cells(i, 4).Value <> Cells(i - 1, 4).Value Then
        a = a + 2
        ReDim Preserve mass(1 To 2, 1 To a)
        mass(1, a - 1) = Cells(i, 4).Value: mass(2, a - 1) = "Группа1"
        mass(1, a) = Cells(i, 4).Value: mass(2, a) = "Группа2"
    End If
    a = a + 1
    ReDim Preserve mass(1 To 2, 1 To a)
    mass(1, a) = Cells(i, 4).Value: mass(2, a) = Cells(i, 5).Value
Next
Range("J5").Resize(a, 2) = Application.Transpose(mass)
End Sub
Изменено: yozhik - 2 Апр 2018 12:14:46
 
yozhik, Спасибо большое! Данный макрос то, что надо!
Казанский, спасибо большое, но у меня почему-то не получилось сделать с ним. Только начинаю работать с VBA, поэтому возможно я что-то не так сделал)
Изменено: ArturioGattiii - 2 Апр 2018 13:26:59
 
ArturioGattiii, я исходил из того, что файл-пример отличается от реальных данных и столбец "Признак 1" может быть в другом месте, поэтому дал возможность выбрать этот столбец через активную ячейку.
Замените 3 строку на c=4 и макрос сработает в файле-примере независимо от активной ячейки.
 
Казанский, спасибо. Буду знать :)
Страницы: 1
Читают тему (гостей: 1)
Наверх