将用户选择的范围传入数组，然后传入用户表单文本框

Question

我试图让我的代码提示用户选择3宽度和可变长度的数据范围。只有30个值，其中一些行是空白的。我想让这30个值填充到我的用户表单中的30个文本框中(这样就不必手动输入值)。我环顾四周，发现我的路线应该是Application.Inputbox，然后将其传递到一个数组中，空白行可以用for循环清除。我不知道如何将用户选择的表传递到2D数组中。

Sub selectRange()
Dim r(1 To 14, 1 To 3) As Variant, ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set r = Application.InputBox("Select the Cal B table.", Type:=8)
For j = 1 To 14
    For i = 1 To 3
        If Abs(r(j, i)) > 0 Then
            calB(l) = r(j, i)
            l = l + 1
        End If
    Next
Next
    lx = calB(1)
    ly = calB(2)
    lz = calB(3)
    rx = calB(4)
    ry = calB(5)
    rz = calB(6)
    ix = calB(7)
    iy = calB(8)
    iz = calB(9)
    sx = calB(10)
    sy = calB(11)
    sz = calB(12)
    p1x = calB(13)
    p1y = calB(14)
    p1z = calB(15)
    p2x = calB(16)
    p2y = calB(17)
    p2z = calB(18)
    lfx = calB(19)
    lfy = calB(20)
    lfz = calB(21)
    lrx = calB(22)
    lry = calB(23)
    lrz = calB(24)
    rfx = calB(25)
    rfy = calB(26)
    rfz = calB(27)
    rrx = calB(28)
    rry = calB(29)
    rrz = calB(30)
    ActiveWorkbook.Close
    dozercall.Show
End Sub

提前感谢大家的帮助。

Answer 1

编辑:我错过了您使用输入框的错误，但是我将留下这个答案，因为它提供了一种方法，将用户输入的可变范围从多维数组折叠到单个维度数组

这应该让你开始。基本上，它将读取用户的输入，动态地创建一个正确大小的一维数组(行*列)，并将用户选择的范围内的所有值读入这个一维数组。然后循环遍历一维数组并将值打印回窗口。

我想这就是你想要的，但如果你需要进一步的澄清，我可以添加一些。我添加了注释，这样你就可以看到每个部分在做什么。

Option Explicit
Private Sub TestArrays()
        Dim calBTemp() As Variant, calB() As Variant
        Dim i As Long, j As Long, x As Long
        Dim rngInput As Range
        Set rngInput = Application.InputBox("Select the Cal B table.", "Select Range", Type:=8)
        'Read the user input, check for empty input
        'If empty input, exit the subroutine
        If Not rngInput Is Nothing Then
                calBTemp = rngInput
        Else
                Exit Sub
        End If
        'Create the one-dimensional array dynamically based on user selection
        ReDim calB((UBound(calBTemp, 1) - LBound(calBTemp, 1) + 1) * (UBound(calBTemp, 2) - LBound(calBTemp, 2) + 1))
        'Loop through our multidimensional array
        For i = LBound(calBTemp, 1) To UBound(calBTemp, 1)
                For j = LBound(calBTemp, 2) To UBound(calBTemp, 2)
                        'Assign the value to our one dimensional array
                        calB(x) = calBTemp(i, j)
                        x = x + 1
                Next j
        Next i
        'Loop through our one dimensional array
        For i = LBound(calB) To UBound(calB)
                Debug.Print calB(i)
        Next i
End Sub

Answer 2

所以我只是没有正确使用Application.Inputbox。如果你将它作为一个范围返回，它将配置为适当大小的2D数组，你可以从那里调用/操作数据。这是一个工作sub。

Sub selectRange()
Dim ran As Range, calB(1 To 30) As Double, i As Integer, j As Integer, k As Integer, l As Integer
dozerCal.Hide
Set ran = Application.InputBox("Select the Cal B table.", Type:=8)
l = 1
For j = 1 To 14
    For i = 1 To 3
        If Abs(ran(j, i)) > 0 Then
            calB(l) = ran(j, i)
            l = l + 1
        End If
    Next
Next
    lx = calB(1)
    ly = calB(2)
    lz = calB(3)
    rx = calB(4)
    ry = calB(5)
    rz = calB(6)
    ix = calB(7)
    iy = calB(8)
    iz = calB(9)
    sx = calB(10)
    sy = calB(11)
    sz = calB(12)
    p1x = calB(13)
    p1y = calB(14)
    p1z = calB(15)
    p2x = calB(16)
    p2y = calB(17)
    p2z = calB(18)
    lfx = calB(19)
    lfy = calB(20)
    lfz = calB(21)
    lrx = calB(22)
    lry = calB(23)
    lrz = calB(24)
    rfx = calB(25)
    rfy = calB(26)
    rfz = calB(27)
    rrx = calB(28)
    rry = calB(29)
    rrz = calB(30)
    ActiveWorkbook.Close
    dozerCal.Show
End Sub

Answer 3

下面的代码将达到这个目的(并强制用户选择3列14行):

Sub selectRange()
    Dim selectedRange As Range
    Dim errorMessage As String
    errorMessage = vbNullString
    Dim ran As Range, calB(1 To 30) As Long, i As Integer, j As Integer, k As Integer, l As Integer
    Do
        'doesn't handle cancel event
        Set selectedRange = Application.InputBox("Select the Cal B table.", _
        Type:=8, Title:="Please select 14 rows and 3 columns" & errorMessage)
        errorMessage = "; previous selection was invalid"
    Loop While selectedRange.Columns.Count <> 3 Or selectedRange.Rows.Count <> 14
    For j = 1 To 14
        For i = 1 To 3
            If Abs(selectedRange.Cells(j, i)) > 0 Then
                calB(l) = selectedRange.Cells(j, i)
                l = l + 1
            End If
        Next
    Next
...rest of your code