Question

我正在尝试将一系列单元格地址输入到VBA中的数组中。

我的代码目前声明：

Do
    Range1 = Application.InputBox(Prompt:="Please select the cell to add to the Array. Press ""Cancel"" when all Ranges have been added.", Title:="Range Select", Type:=8)
    If Range1 <> False Then
        ReDim Preserve TestArray(Count)
        Set TestArray(Count) = Range1.Address
    End If
    Count = Count + 1
Loop Until Range1 = False

最后，我正在寻找像（A1，C3，D6，G8）

这样的东西

这不起作用。

我稍后会使用以下内容来使用这些范围：

TestArray（i）.Value = TestArray（i）.Value * 1.01

如何创建范围数组？

提前致谢

Answer 1

以下是创建和使用单元格（Range）地址数组的简短示例：

Sub RangeArray()
    Dim addy()
    addy = Array("A1", "B9", "C11", "D17")
    For i = 0 To 3
        Range(addy(i)).Value = i + 100
    Next i
End Sub

Answer 2

以下是您可以做的事情：

Sub test()
    Dim TestArray() As String
    Dim count As Integer
    Dim Range1 As Range
    Dim el

    Do
        Set Range1 = Nothing

        On Error Resume Next
        Set Range1 = Application.InputBox(Prompt:="Please select the cell to add to the Array." & _
                            "Press ""Cancel"" when all Ranges have been added.", _
                            Title:="Range Select", Type:=8)
        On Error GoTo 0
        'if Cancel pressed - exit do
        If Range1 Is Nothing Then Exit Do

        ReDim Preserve TestArray(count)

        TestArray(count) = Range1.Address
        count = count + 1
    Loop While True
    'test loop through array
    For Each el In TestArray
        MsgBox "Address " & el & ", Value " & Range(el).Value
    Next el
End Sub

但我个人更喜欢使用Collection而不是ReDim Preserve：

Sub test2()
    Dim TestCol As Collection
    Dim count As Integer
    Dim Range1 As Range
    Dim el

    Set TestCol = New Collection

    Do
        Set Range1 = Nothing

        On Error Resume Next
        Set Range1 = Application.InputBox(Prompt:="Please select the cell to add to the Array." & _
                            "Press ""Cancel"" when all Ranges have been added.", _
                            Title:="Range Select", Type:=8)
        On Error GoTo 0
        'if Cancel pressed - exit do
        If Range1 Is Nothing Then Exit Do

        TestCol.Add Item:=Range1.Address
    Loop While True
    'test loop through collection
    For Each el In TestCol
        MsgBox "Address " & el & ", Value " & Range(el).Value
    Next el
End Sub

范围地址数组

2 个答案: