如何阅读动态范围？

Question

我正在尝试创建一个读取数据并对数据进行计量经济学的宏。此时我正在尝试实现潜变量MLE估计。

数据可以是任意长度，具体取决于用户输入。假设列O和列P中有数据。事前我不知道存在多少行数据。

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

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

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

我尝试过“Variant”和“Array”类型。 Variant似乎正在工作，但Array不是。

Sub SampleStats()


Dim Rng As String


Dim Var1(1 To 100) As Double
Dim Var2() As Double
Dim Var3 As Variant
Dim NumElements2 As Integer
Dim length2 As Integer

NumElements2 = WorksheetFunction.Count(Range("P:P")) 
length2 = NumElements2+1    

MsgBox NumElements2

ReDim Var2(1 To NumElements2)

Rng = "P2:P" & length2

MsgBox Rng

Var3 = Range(Rng).Value
MsgBox Var3(1,1) 


Var2 = Range(Rng).Value


MsgBox Var2(1,1)



End Sub

我的问题是：

1. 当您不知道列的长度时，读取数据的最佳方式是什么？
2. 当最终目标进行一些统计时，存储数据的最佳方式（Variant或Array或其他东西）是什么？

Answer 1

首先，您将Range包含要传递到数组中的数据列。其次，您对数据使用Application.Transpose函数并将其分配给Variant，以便从Range.Value属性创建一维数组。

如果您只是将范围Value直接分配给Variant，您将获得一个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

Answer 2

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