Excel VBA Создание новых ячеек на основе данных ячеек

поэтому я пытаюсь создать что-то, что создаст количество ячеек X, когда «X» вводится в соответствующую ячейку, а затем заполняет эти ячейки числами, считая до X.

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

С чего начнется таблица

...|........A........|.............B...............|..........C........

1.|.................| Введите данные ниже.|

2.|Вопрос 1| _______________|

3.|Вопрос 2| _______________|

4.|Вопрос 3| _______________|

Ввод данных ("Вопрос 1" не действует, но после ввода вопроса 2 "B3" будут созданы ячейки)

...|........A........|.............B...............|..........C........

1.|.................| Введите данные ниже.|

2.|Вопрос 1| _____Ответ____|

3.|Вопрос 2| _______3_______| ‹---------------

4.|Вопрос 3| _______________|

Затем количество ячеек будет создано на основе количества, введенного в "B3"

...|........A........|.............B...............|..........C........

1.|.................| Введите данные ниже.|

2.|Вопрос 1| _____Ответ____|

3.|Вопрос 2| _______3_______|

4.|Q1..............| _______________| ‹---------------

5.|Вопрос 2.............| _______________| ‹---------------

6.|Q3.............| _______________| ‹---------------

7.|Вопрос 3| _______________|

Если бы кто-нибудь мог помочь, это было бы очень признательно. Не стесняйтесь запрашивать любую дополнительную информацию.


excel vba cells
person VBAnoob    schedule 06.07.2015    source источник

Ответы (1)


arrow_upward
0
arrow_downward

Вставьте это в модуль рабочего листа, который вас интересует:

Public InModif As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

If InModif = True Then Exit Sub
Application.ScreenUpdating = False
InModif = True

Dim NbInsert As Integer

If Target.Count > 1 Then Exit Sub
If Not Application.Intersect(Target, Me.Columns(2)) Is Nothing Then
    If IsNumeric(Target.Value) Then
        NbInsert = CInt(Target.Value)
        Do While NbInsert <> 0
            Rows(Target.Offset(1, 0).Row).Insert Shift:=xlDown
            Target.Offset(1, 0).Value = NbInsert
            Target.Offset(1, -1).Value = "Q" & NbInsert
            NbInsert = NbInsert - 1
        Loop
    Else
    End If
Else
End If

InModif = False
Application.ScreenUpdating = True

End Sub
person R3uK    schedule 06.07.2015