Вставка ячейки в excel на основе значения ячейки

Question

Я работаю над экспортом CSV больших групп из активной среды каталога. Многие из этих групп имеют обширное гнездование, и мне нужно вставить ячейки, чтобы рабочий лист был удобочитаемым человеком.

Например мой лист выглядит следующим образом: WS Пример

Path Int Пользователь

0 User1 CN

0 Пользователь2 CN

1 User3 CN

1 User4 CN

0 USER5 CN

1 User6 CN

2 User7 CN

Ищу помощью адаптации сценария VBA, который считывает целое значение из первого столбца и вставляет соответствующее количество ячейки слева от столбца для этой конкретной строки. Ограничение состоит в том, что список не может изменить порядок строк, чтобы сохранить вложенную структуру.

Вот что я имею в VBA до сих пор

Sub test() 
Dim d As Integer 
d = Range("A:A").End(xlDown).row 
Dim c As Range 
    For i = d To 1 Step -1 
    If Cells(i, 1).Value Like "1" Then 
    Rows(Cells(i, 1).Column).Insert shift:=xlShiftRight 
    End If 
    Next 
End Sub 

В настоящее время этот фрагмент подсчитывает количество 1-х из колонки и вставляет новую строку в верхней части списка. Я считаю, что ошибка в моей логике находится внутри оператора If, и, как только у меня это получилось, я знаю, что могу расширить это с помощью ElseIf для решения остальных значений.

Answer 1

Это сделает это. Проблема выглядит так, как будто она находится в строке Rows(Cells(i, 1).Column).Insert shift:=xlShiftRight. Если вы нарушите что вниз, он вычисляет следующим образом:

Cells(i,1).Column, которая равна 1, так как столбец .Cells(i,1) равен 1. Rows(1)1 происходит от выше. Таким образом, Rows(1) равен 1. Rows(1).Insert Вставляет над строкой 1, независимо от того, что вы указываете для смены.

Sub test() 
Dim d As Integer 
d = Range("A:A").End(xlDown).row 
Dim c As Range 
    For i = d To 1 Step -1 
    If Cells(i, 1).Value Like "1" Then 
     Cells(i, 1).Insert shift:=xlToRight 
    End If 
    Next 
End Sub 

Answer 2

Это должно быть сделано.

Sub test() 
Dim d As Integer 
d = Range("A:A").End(xlDown).Row 
Dim c As Range 
    For i = d To 1 Step -1 
    aMove = Val(Cells(i, 1)) 
    If aMove > 0 Then 
    Range(Cells(i, 1), Cells(i, aMove)).Insert shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
    End If 
    Next 
End Sub 

Answer 3

Довольно много способов сделать это, но с помощью номера в Columna, чтобы определить количество ячеек для вставки вы можете сделать вторую петлю следующим образом:

Private Sub CommandButton1_Click() 
Dim x, d, i As Integer 
With ActiveSheet 
d = .Range("A:A").End(xlDown).Row 
    For x = 2 To d 
    i = .Cells(x, 1).Value 
     For a = 1 To i 
      .Cells(x, 1).Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove 
     Next a 
    Next x 
End With 
End Sub