從另一個陣列

我嘗試使用下面的代碼從現有的2維數組填充了獨特的鍵與值的最後一個數組VBA填充數組：最終陣列有3個維度的數據，我想數組看看像這樣：從另一個陣列

Finalarray（0）：{A，1，4，8} .... Finalarray（4）：{E，空，空，12}

我的代碼初始化上面與陣列關鍵字即a，b，c，d，e但是，我不確定什麼是最好的一般填充方式！

假設每個「一」的條目是新一行

我的嘗試，目前的工作（但很手動）這只是挑出來的「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

來源

2017-09-25 user8608110

你是否試圖在每一行中找到沒有重複的單元格，並確定它們的列號？ –

最終我想要A，B，CD，E爲列和條目爲行之下，但這樣做，我需要輸出Finalarray（0）：{A，1，4，8} .... Finalarray（4）：首先是{e，Empty，Empty，12}數組。 – user8608110

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

來源

2017-09-25 14:08:10 user8608110

從另一個陣列

回答

相關問題