Arrays VBA从另一个数组填充数组

我正在尝试使用以下代码获取一个最终数组，该数组填充了唯一键，其中包含来自现有二维数组的值： 最后一个数组有3个数据维度，我希望数组如下所示：

最后一行（0）：{a，1，4，8}。。。。最后一行（4）：{e，空，空，12}

我的代码使用键a、b、c、d、e初始化上面的数组，但我不确定最好的填充方式是什么

假设每个“a”条目都是新行

我目前的尝试（但非常手动）是选择“e”：

子阵列测试（）
作为变体的Dim-dekeys
变光数据（0到2，0到3）作为变量
暗rRef As范围
将DData作为变体
作为变体的Darray
作为整数的Dim i
作为变体的暗淡独特的眼睛
暗终射线
作为整数的Dim常量
PreservedKeys=数组（“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）
常数=3
重拨合并Darray（0到UBound（保留键），0到1）
对于i=0到UBound（保留键）
合并Darray（i，0）=保留的Dkeys（i）
合并数据（i，1）=保留数据（i）
接下来我
uniquePreservedKeys=M_snb（PreservedKeys）
重播最终光线（0到UBound（唯一保留键），0到常量）
对于i=0到4
最终射线（i，0）=唯一保留射线（i）
接下来我
Set rRef=Application.Range（“TestRange”）
rRef.Resize（UBound（数据，1）+1，UBound（数据，2）+1）=数据
'到目前为止，我的尝试-->非常手动，仅获取e条目
如果MergedArray（i，0）=“a”，那么
计数器=计数器+1
如果结束
如果计数器=1，则
如果合并Darray（i，0）“e”，则
最终射线（4，计数器）=“
其他的
最终光线（4，计数器）=合并光线（i，1）
如果结束
如果结束
如果计数器=3，则
如果合并Darray（i，0）“e”，则
最终射线（4，计数器）=“
其他的
最终光线（4，计数器）=合并光线（i，1）
如果结束
如果结束
接下来我
端接头
功能M_snb（作为变体的唯一键）
使用CreateObject（“scripting.dictionary”）
对于每一个，它都是唯一的
c10=.Item（it）
下一个
an=.keys'数组。keys包含所有唯一的键
以
M_snb=an
端函数

子阵列测试（）
作为变体的Dim-dekeys
变光数据（0到2，0到3）作为变量
暗rRef As范围
将DData作为变体
作为变体的Darray
作为整数的Dim i
作为变体的暗淡独特的眼睛
暗终射线
作为整数的Dim常量
PreservedKeys=数组（“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）
常数=3
重拨合并Darray（0到UBound（保留键），0到1）
对于i=0到UBound（保留键）
合并Darray（i，0）=保留的Dkeys（i）
合并数据（i，1）=保留数据（i）
接下来我
uniquePreservedKeys=M_snb（PreservedKeys）
重播最终光线（0到UBound（唯一保留键），0到常量）
对于i=0到4
最终射线（i，0）=唯一保留射线（i）
接下来我
对于i=0到UBound（最终射线）
计数器=0
对于k=0到UBound（合并Darray）
如果MergedArray（k，0）=“a”，那么
计数器=计数器+1
如果结束
如果MergedArray（k，0）FinalArray（i，0），那么
转到标签
其他的
最终射线（i，计数器）=合并射线（k，1）
如果结束
标签：
下一个k
接下来我
Set rRef=Application.Range（“TestRange”）
rRef.Resize（UBound（FinalArray，1）+1，UBound（FinalArray，2）+1）=FinalArray
端接头
功能M_snb（作为变体的唯一键）
使用CreateObject（“scripting.dictionary”）
对于每一个，它都是唯一的
c10=.Item（it）
下一个
an=.keys'数组。keys包含所有唯一的键
以
M_snb=an
端函数

子阵列测试（）
作为变体的Dim-dekeys
变光数据（0到2，0到3）作为变量
暗rRef As范围
将DData作为变体
作为变体的Darray
作为整数的Dim i
作为变体的暗淡独特的眼睛
暗终射线
作为整数的Dim常量
PreservedKeys=数组（“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）
常数=3
重拨合并Darray（0到UBound（保留键），0到1）
对于i=0到UBound（保留键）
合并Darray（i，0）=保留的Dkeys（i）
合并数据（i，1）=保留数据（i）
接下来我
uniquePreservedKeys=M_snb（PreservedKeys）
重播最终光线（0到UBound（唯一保留键），0到常量）
对于i=0到4
最终射线（i，0）=唯一保留射线（i）
接下来我
对于i=0到UBound（最终射线）
计数器=0
对于k=0到UBound（合并Darray）
如果MergedArray（k，0）=“a”，那么
计数器=计数器+1
如果结束
如果MergedArray（k，0）FinalArray（i，0），那么
转到标签
其他的
最终射线（i，计数器）=合并射线（k，1）
如果结束
标签：
下一个k
接下来我
Set rRef=Application.Range（“TestRange”）
rRef.Resize（UBound（FinalArray，1）+1，UBound（FinalArray，2）+1）=FinalArray
端接头
功能M_snb（作为变体的唯一键）
使用CreateObject（“scripting.dictionary”）
对于每一个，它都是唯一的
c10=.Item（it）
下一个
an=.keys'数组。keys包含所有唯一的键
以
M_snb=an
端函数

您是否试图在每行中查找不重复的单元格，并确定其列号？最终我希望a、b、CD、e作为列，条目作为行，但要做到这一点，我需要输出最终数组（0）：{a、1、4、8}。。。。Finalarray（4）：{e，Empty，Empty，12}首先数组。您是否试图查找每行中没有重复项的单元格，并确定它们的列号？最终我希望a，b，cd，e作为列，条目作为行，但要做到这一点，我需要输出Finalarray（0）：{a，1，4，8}。。。。最后一行（4）：{e，空，空，12}首先是数组。

    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

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