ダイナミックレンジを読み取るには？

Question

私は、データを読み込み、データの計量経済学を行うマクロを作成しようとしています。この時点で、私は潜在的な変数MLE推定を実装しようとしています。

データは、ユーザー入力によって任意の長さにすることができます。先ほどのO列とP列にデータがあるとします。

最初に何個のデータがあるのか​​を読んでから、配列変数にデータをアップロードしてから計量統計を行うことができます。

この問題では、ユーザーは変数ごとに25のデータポイントを持っています。他のユーザの中には、データポイントの数が異なる異なるデータを入力するものがあります。

以下のコードでは、変数 "D"を配列に読み込もうとしています。まず、空でないセルの数を数え、そのサイズの配列を作成し、セルの値を配列に読み込もうとします。しかし、私は "タイプの不一致"エラーが発生しています。

"バリアント"と "アレイ"の両方のタイプを試しました。バリアントは動作しているようですが、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. 最終的な目的が統計を行っているときに、データ（バリアントまたは配列など）を格納する最良の方法は何ですか？

Answer 1

最初にRangeに、配列に渡すデータの列が表示されます。次に、データに対してApplication.Transpose関数を使用してVariantに割り当て、Range.Valueプロパティから1次元配列を作成します。

範囲のValueをVariantに直接割り当てると、N行×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