Страницы: 1
RSS
Добавление строки по условию изменения ячейки в строке, Макросы VBA
 
Необходимо написать макрос который, после каждого уникального значения ячейки, вставляет первую (1:1) строку листа.

Следующий макрос ищет уникальные значения, но вставляет пустую строку, а мне нужно что б вставлялась именно первая.

Код
Sub InsertRow()
Dim i As Long, rCell As Range
    For Each rCell In Selection 'Цикл по выделенным ячейкам
        If rCell <> "" Then 'Если текущая ячейка не пуста, то
            If rCell.Offset(1, 0) <> rCell Then rCell.Offset(1, 0).EntireRow.Insert 'Если значение в ячейке "ниже" не равно значению в текущей ячейке, то вставляем строку
        End If
    Next
End Sub
 
Код
If rCell.Offset(1, 0) <> rCell Then Rows("1:1").Insert
Согласие есть продукт при полном непротивлении сторон
 
Не работает
Данный код просто вставляет пустую строку вначале, до того момента пока и вовсе ексель не зависнет
 
Цитата
Nikolay_Karpovets написал:
после каждого уникального значения ячейки

Nikolay_Karpovets, а что в данном случаем Вы понимаете под уникальными значениями? В Вашем макросе я  ничего не вижу про уникальные.
 
этот "льупощак" (For...Each...Next) не подходящий
может так ?
Код
Option Explicit

Sub InsertRow_1()
    Dim r&: r = 1
    Dim rws&: rws = Selection.Rows.Count
    Do While r < rws
        If Trim(Cells(r, 1).Value) <> "" Then
            If Cells(r, 1).Offset(1, 0).Value <> Cells(r, 1).Offset(0, 0).Value Then
                Rows(1).Copy
                Cells(r, 1).Offset(1, 0).Insert
                Application.CutCopyMode = False
                Selection.Resize(rws + 1).Select 'это не обязательно
                rws = rws + 1
                r = r + 1
            End If
        End If
        r = r + 1
    Loop
End Sub
 
763577 477 Б 25,15 1 25
763577 646111 А 12,00 3 150
763577 737221 Б 11,40 1 600
763577 662376 А 18,48 1 44
№ лота № п/п Наименование Вес Кол. е.о. Кол. шт.
763578 500718 Б 0,51 1 5
763578 5679 А 0,78 1 3
763578 607039 Б 1,25 1 25
763578 597388 А 3,02 2 48
763578 701787 Б 0,30 1 10
763578 738975 А 0,22 1 10

Пример как должно быть.
После числа 763577 вставляем строку (№ лота № п/п Наименование Вес Кол. е.о. Кол. шт.)
И так перед началом каждого нового (уникального)  значения
 
Цитата
Юрий М написал: В Вашем макросе я  ничего не вижу про уникальные.
Вот именно данная строка и указывает на уникальность нижестоящего текста (в моем случае числа)
Код
If rCell.Offset(1, 0) <> rCell Then rCell.Offset(1, 0).EntireRow.Insert  'Если значение в ячейке "ниже" не равно значению в текущей ячейке, то вставляем строку

Then rCell.Offset(1, 0).EntireRow.Insert- Вставляет строку именно перед обнаруженной уникальной ячейки
 
наконец какой-то пример ... :)
попробуйте, это ваша расширенная версия:
Код
Option Explicit

Sub InsertRow_2()
    Dim r&: r = 2
    Dim rws&: rws = Range("a1").CurrentRegion.Rows.Count
    Dim col%: col = Range("a1").CurrentRegion.Columns.Count
    Dim zaglwk(): zaglwk = Range("a1").Resize(1, col).Value
    Application.ScreenUpdating = False
    Application.Calculation = xlManual
    Do While r < rws
        If Cells(r, 1).Value <> "" Then
            If Cells(r + 1, 1).Value <> Cells(r, 1).Value Then
                Rows(r + 1).Insert Shift:=xlDown
                Cells(r + 1, 1).Resize(1, col).Value = zaglwk
                rws = rws + 1
                r = r + 1
            End If
        End If
        r = r + 1
    Loop
    Erase zaglwk
    Application.Calculation = xlAutomatic
    Application.ScreenUpdating = True
End Sub
Страницы: 1
Наверх