Макрос на автоматическую вставку строк в excel

Макрос на автоматическую вставку строк в excel

Представляю вашему вниманию макрос на автоматическую вставку строк в excel по условию.

For a = 14 To 1857    
        If Cells(a, 7).Value <> vbNullString Then
            If InStr(1, Cells(a, 7).Value, ",", vbTextCompare) > 0 Then
                arrarticul = Split(Cells(a, 7).Value, ",")
                For i = Lbound(arrarticul, 1) To Ubound(arrarticul, 1)
                  Cells(a+i+1, 7).EntireRow.Insert Shift:=xlUp
                  Cells(a+i+1, 1).Value = Cells(a, 1).Value
                  Cells(a+i+1, 6).Value = arrarticul(i)
                  Cells(a+i+1, 9).Value = "Замена"
                Next i
            ElseIf InStr(1, Cells(a, 7).Value, " ", vbTextCompare) > 0 Then
            
            Else
            Cells(a+1, 7).EntireRow.Insert Shift:=xlUp
            Cells(a+1, 1).Value = Cells(a, 1).Value
            Cells(a+1, 6).Value = Cells(a, 7).Value
            Cells(a+1, 9).Value = "Замена"
            End If
        End If    
Next a

Описание работы. а задает диапазон строк, далее проверяем условие на наличие символа в ячейке, затем создаем массив по содержимому и далее еще несколько обратных условий. EntireRow.Insert Shift:=xlUp вставляет строки вниз от текущей, и потом в этой строке задаем значения.

Добавить комментарий

Закрыть меню