Vba 如何读取动态范围？

我试图创建一个宏来读取数据，并对数据进行计量经济学分析。在这一点上，我试图实现一个潜在变量的最大似然估计

根据用户输入，数据可以是任意长度。假设O列和P列中有数据。在此之前，我不知道存在多少行数据

我想先读取有多少数据，然后将数据上传到数组变量中，然后才能对其进行计量经济学/统计

在这个问题中，用户对每个变量有25个数据点。其他一些用户可能会使用不同的数据点数量输入不同的数据

在下面的代码中，我试图将变量D读入数组。我首先计算非空单元格的数量，然后创建一个该大小的数组，并尝试将单元格的值读入数组。但是我得到了一个类型不匹配错误

我尝试过变量和数组类型。变体似乎可以工作，但数组不能

我的问题是：

当您不知道列的长度时，读取数据的最佳方式是什么？ 当最终目标是做一些统计时，存储数据变量、数组或其他东西的最佳方式是什么？ 首先，获取要传递到数组中的数据列的范围。其次，对数据使用Application.Transpose函数，并将其分配给变量，以从Range.Value属性创建一维数组

如果您只是将范围的值直接分配给变量，您将得到一个N行x 1列的二维数组。示例代码：

Option Explicit

Sub GetRangeToArray()

    Dim ws As Worksheet
    Dim rngData As Range
    Dim varData As Variant
    Dim lngCounter As Long

    ' get worksheet reference
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ' get the column to analyse - example here is A2:A last row
    ' so using 1 in column reference to Cells collection
    Set rngData = ws.Cells(2, 1).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp))

    ' convert range from 2d to 1d array
    varData = Application.Transpose(rngData.Value)

    ' test array
    For lngCounter = LBound(varData) To UBound(varData)
        Debug.Print varData(lngCounter)
    Next lngCounter

End Sub

首先，获取要传递到数组中的数据列的范围。其次，对数据使用Application.Transpose函数，并将其分配给变量，以从Range.Value属性创建一维数组

如果您只是将范围的值直接分配给变量，您将得到一个N行x 1列的二维数组。示例代码：

Option Explicit

Sub GetRangeToArray()

    Dim ws As Worksheet
    Dim rngData As Range
    Dim varData As Variant
    Dim lngCounter As Long

    ' get worksheet reference
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    ' get the column to analyse - example here is A2:A last row
    ' so using 1 in column reference to Cells collection
    Set rngData = ws.Cells(2, 1).Resize(ws.Cells(ws.Rows.Count, 1).End(xlUp))

    ' convert range from 2d to 1d array
    varData = Application.Transpose(rngData.Value)

    ' test array
    For lngCounter = LBound(varData) To UBound(varData)
        Debug.Print varData(lngCounter)
    Next lngCounter

End Sub

---

变量是好的，数组不工作，正如你所发现的。我会将信息可以设置的潜在范围设置为数组，然后从数组中删除空格变量是好的，数组不工作，正如你所发现的。我会将信息可以设置的潜在范围设置为数组，然后从数组中删除空格

sub createarraywithoutblanks()
creatary ary, Sheets("Table_Types"), "A":
alternative ary: 
BuildArrayWithoutBlanks ary
end sub

Sub creatary(ary As Variant, sh As Worksheet, ltr As String)
Dim x, y, rng As range
ReDim ary(0)

Set rng = sh.range(ltr & "2:" & ltr & sh.range("A10000").End(xlUp).Row).SpecialCells(xlCellTypeVisible)

x = 0
For Each y In rng
    ary(x) = y
    x = x + 1
    ReDim Preserve ary(x)
Next y
End Sub

Function Letter(oSheet As Worksheet, name As String, Optional num As Integer)
If num = 0 Then num = 1
Letter = Application.Match(name, oSheet.Rows(num), 0)
Letter = Split(Cells(, Letter).Address, "$")(1)
End Function

Sub alternative(ary As Variant)
Dim Array_2()
Dim Array_toRemove()

Dim dic As New Scripting.Dictionary
Dim arrItem, x As Long
For Each arrItem In ary
    If Not dic.Exists(arrItem) Then
        dic.Add arrItem, arrItem
    Else
        ReDim Preserve Array_toRemove(x)
        Array_toRemove(x) = dic.Item(arrItem)
        x = x + 1
    End If
Next
'For Each arrItem In Array_toRemove
'    dic.Remove (arrItem)
'Next arrItem
ary = dic.Keys

End Sub

Sub BuildArrayWithoutBlanks(ary As Variant)
Dim AryFromRange() As Variant, AryNoBlanks() As Variant
Dim Counter As Long, NoBlankSize As Long

'set references and initialize up-front
ReDim AryNoBlanks(0 To 0)
NoBlankSize = 0

'load the range into array
AryFromRange = ary

'loop through the array from the range, adding
'to the no-blank array as we go
For Counter = LBound(AryFromRange) To UBound(AryFromRange)
    If AryFromRange(Counter) <> 0 Then
        NoBlankSize = NoBlankSize + 1
        AryNoBlanks(UBound(AryNoBlanks)) = AryFromRange(Counter)
        ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) + 1)
    End If
Next Counter

'remove that pesky empty array field at the end
If UBound(AryNoBlanks) > 0 Then
    ReDim Preserve AryNoBlanks(0 To UBound(AryNoBlanks) - 1)
End If

'debug for reference
ary = AryNoBlanks

End Sub