如何读取dynamic范围？

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

数据可以是任何长度，取决于用户input。 假设列O和列P中有数据。事前我不知道有多less行数据存在。

我想首先读取有多less数据，然后将数据上传到我的数组variables，然后我可以做任何计量经济学/统计数据。

在这个问题中，用户每个variables有25个数据点。 其他一些用户可能会input不同数据点的数据。

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

我已经尝试了“Variant”和“Array”types。 变体似乎在工作，但arrays不是。

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. 当你不知道列的时间是多less时，读取数据的最好方法是什么？
2. 什么是最好的方式来存储数据（Variant或数组或其他）当最终目标是做一些统计？

Answer 1

首先你需要将数据列传入数组。 其次，对数据使用Application.Transpose函数，并将其分配给Variant以从Range.Value属性创build一维数组。

如果您只是将范围的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