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

时间:2019-09-20 02:31:18

标签: excel vba excel-2010

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

1 个答案:

答案 0 :(得分: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