如何将不同的数据添加到一系列单元格中

How to add different data into a range of cells

我对 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

您可以将所有水果放入一个数组中,然后循环遍历它们

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