如何讀取動態範圍？

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