VBA別の配列から配列を取り込みます

Question

次のコードを使用して、既存の2次元配列の値を持つ固有のキーを格納した最終配列を取得しようとしています： 最後の配列にはDataの3次元があります。

Finalarray（0）：{1、4、8} ... Finalarray（4）：このよう{E、空、空、12}

マイコードが有する上記配列を初期化キーは、すなわち、A、B、C、D、Eが、私はどのような最も一般的な人口の方法があるかわからない！

Sub ArrayTest() 
    Dim PreservedKeys As Variant 
    Dim Data(0 To 2, 0 To 3) As Variant 
    Dim rRef As Range 
    Dim PreservedData As Variant 
    Dim MergedArray As Variant 
    Dim i As Integer 
    Dim uniquePreservedKeys As Variant 

    Dim FinalArray 
    Dim Constant As Integer 

    PreservedKeys = Array("a", "b", "c", "a", "b", "c", "d", "a", "b", "c", "d", "e") 
    PreservedData = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) 
    Constant = 3 


    ReDim MergedArray(0 To UBound(PreservedKeys), 0 To 1) 

     For i = 0 To UBound(PreservedKeys) 

     MergedArray(i, 0) = PreservedKeys(i) 
     MergedArray(i, 1) = PreservedData(i) 

     Next i 


    uniquePreservedKeys = M_snb(PreservedKeys) 

    ReDim FinalArray(0 To UBound(uniquePreservedKeys), 0 To Constant) 

    For i = 0 To 4 
     FinalArray(i, 0) = uniquePreservedKeys(i) 
    Next i 



    Set rRef = Application.Range("TestRange") 

    rRef.Resize(UBound(Data, 1) + 1, UBound(Data, 2) + 1) = Data 

    'MY ATTEMPT SO FAR --> Very manual to just get the e entry 
     If MergedArray(i, 0) = "a" Then 
      counter = counter + 1 
     End If 

    If counter = 1 Then 
     If MergedArray(i, 0) <> "e" Then 
      FinalArray(4, counter) = "" 
     Else 
     FinalArray(4, counter) = MergedArray(i, 1) 
     End If 
    End If 

     If counter = 3 Then 
     If MergedArray(i, 0) <> "e" Then 
      FinalArray(4, counter) = "" 
     Else 
     FinalArray(4, counter) = MergedArray(i, 1) 
     End If 
    End If 


    Next i 


    End Sub 


Function M_snb(UniqueKeys As Variant) 
     With CreateObject("scripting.dictionary") 
      For Each it In UniqueKeys 
       c10 = .Item(it) 
      Next 
      an = .keys ' the array .keys contains all unique keys 

     End With 

    M_snb = an 

    End Function 

Answer 1

Sub ArrayTest() 
Dim PreservedKeys As Variant 
Dim Data(0 To 2, 0 To 3) As Variant 
Dim rRef As Range 
Dim PreservedData As Variant 
Dim MergedArray As Variant 
Dim i As Integer 
Dim uniquePreservedKeys As Variant 

Dim FinalArray 
Dim Constant As Integer 

PreservedKeys = Array("a", "b", "c", "a", "b", "c", "d", "a", "b", "c", "d", "e") 
PreservedData = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) 
Constant = 3 


ReDim MergedArray(0 To UBound(PreservedKeys), 0 To 1) 

    For i = 0 To UBound(PreservedKeys) 

    MergedArray(i, 0) = PreservedKeys(i) 
    MergedArray(i, 1) = PreservedData(i) 

    Next i 


uniquePreservedKeys = M_snb(PreservedKeys) 

ReDim FinalArray(0 To UBound(uniquePreservedKeys), 0 To Constant) 

For i = 0 To 4 
    FinalArray(i, 0) = uniquePreservedKeys(i) 
Next i 


For i = 0 To UBound(FinalArray) 
counter = 0 
For k = 0 To UBound(MergedArray) 


    If MergedArray(k, 0) = "a" Then 
     counter = counter + 1 
    End If 
    If MergedArray(k, 0) <> FinalArray(i, 0) Then 
     GoTo Label 
    Else 
    FinalArray(i, counter) = MergedArray(k, 1) 
    End If 

Label: 
Next k 
Next i 


Set rRef = Application.Range("TestRange") 

rRef.Resize(UBound(FinalArray, 1) + 1, UBound(FinalArray, 2) + 1) = FinalArray 



End Sub 

Function M_snb(UniqueKeys As Variant) 
    With CreateObject("scripting.dictionary") 
     For Each it In UniqueKeys 
      c10 = .Item(it) 
     Next 
     an = .keys ' the array .keys contains all unique keys 

    End With 

M_snb = an 

End Function