Как добавить разные данные в диапазон ячеек

Question

Я очень новичок в кодировании vba, и я прошу прощения, если я не знаю о некоторых проблемах, но я придумала следующую программу, чтобы проверить диапазон, если в строке 2 пустых строки, и если естьэто создаст список во втором ряду.Я также добавил функцию, чтобы увидеть, сколько списков я хочу создать в этом диапазоне.Итак, что мне нужно сделать, это создать определенное количество списка в зависимости от ввода и разместить под каждым списком после 1 пустой строки.Мне нужно включить в список как можно больше фруктов, но он становился немного длиннее, и мне было интересно, могу ли я как-нибудь сократить его.Заранее благодарю и извиняюсь, если задаю немой вопрос.

Sub CreateList()
    Dim Emptyrow As Range
    Dim NumberOfTimes As Integer

    NumberOfTimes = InputBox(prompt:="Enter number of times to create list")
    For Each Emptyrow In Sheets("Fruit").Range("A1:A100")
        If IsEmpty(Emptyrow.Value) = True Then
            If IsEmpty(Emptyrow.Offset(1, 0).Value) = True Then
                If NumberOfTimes > 0 Then
                    With Emptyrow
                        .Offset(1, 0).Value = "apple"
                        .Offset(2, 0).Value = "banana"
                        .Offset(3, 0).Value = "watermelon"
                        .Offset(4, 0).Value = "melon"
                        .Offset(5, 0).Value = "berry"
                        .Offset(6, 0).Value = "pear"
                        .Offset(7, 0).Value = "orange"
                    End With
                    NumberOfTimes = NumberOfTimes - 1
                End If
            End If
        End If
    Next Emptyrow
End Sub

Answer 1

Вы можете собрать все свои фрукты в массив, а затем просто просмотреть их

Sub CreateList()
    Dim Emptyrow As Range
    Dim NumberOfTimes As Integer

    Dim Fruits As Variant
    Fruits = Array("apple", "banana", "watermelon")

    NumberOfTimes = InputBox(prompt:="Enter number of times to create list")
    For Each Emptyrow In Sheets("Fruit").Range("A1:A100")
        If IsEmpty(Emptyrow.Value) = True Then
            If IsEmpty(Emptyrow.Offset(1, 0).Value) = True Then
                If NumberOfTimes > 0 Then
                    With Emptyrow
                        Dim i As Integer
                        For i = 0 To UBound(Fruits)
                            .Offset(i + 1, 0) = Fruits(i)
                        Next i
                    End With
                    NumberOfTimes = NumberOfTimes - 1
                End If
            End If
        End If
    Next Emptyrow
End Sub