如何读取动态范围？

Question

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

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

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

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

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

我试过“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列的2维数组。示例代码：

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