从多维数组中获取唯一值

问题描述：

任何人都可以给我VBA代码来帮助我解决以下问题吗？从多维数组中获取唯一值

我有这样排列的列称为data一些重复的值：

输入

data()= 

    { 

     0,0,0,a,b,a,c,b,c,d,0,0 

     0,0,0,1,2,1,9,2,9,4,0,0 

     0,0,0,r,g,r,w,g,t,w,0,0 

}

我要填充的多维arr与data的非重复值的信息阵列。

而且也：不考虑零个值，它不管做哪个值，您将通过重复那些选择（因为列相等）

输出

arr()= 
{ 

     a,b,c,d 

     1,2,9,4 

     r,g,w,w 

}

只需将非零值复制到新数组，即可轻松删除零。您应该查看“如何从VBA中的数组中删除重复项”。 – Saustin

为什么'w'复制在输出数组中？为什么不'r'或者'g'？或者，这就像Excel的删除重复函数，但转置数据（即在列而不是行）？ – YowE3K

答

一种方式来获得的唯一身份从一个多维数组到另一个
（使用2个字典，内部获取唯一身份证，外部持有他们的字符串）

Option Explicit 

Public Sub GetUniquesFromMultiDimArray() 
    Dim arrData As Variant, arrUniques As Variant, itm As Variant 

    arrData = Array(Split("0,0,0,a,b,a,c,b,c,d,0,0", ","), _ 
        Split("0,0,0,1,2,1,9,2,9,4,0,0", ","), _ 
        Split("0,0,0,r,g,r,w,g,t,w,0,0", ",")) 
    ShowArray arrData, 1 

    Dim d1 As Object, d2 As Object, i As Long, j As Long, k As Long 
    k = 1 
    'each item in d1 holds a string of uniques 
    Set d1 = CreateObject("Scripting.Dictionary") 

    For i = LBound(arrData) To UBound(arrData) 

     'each item in d2 holds non-zero uniques 
     Set d2 = CreateObject("Scripting.Dictionary") 

     For j = LBound(arrData(i)) To UBound(arrData(i)) 
      If arrData(i)(j) <> 0 Then d2(arrData(i)(j)) = vbNullString 
     Next 
     For Each itm In d2 
      d1(k) = d1(k) & itm & ","   'example: "1,2,9,4," 
     Next 
     d1(k) = Left(d1(k), Len(d1(k)) - 1)  'example: "1,2,9,4" 
     k = k + 1 
    Next 
    ReDim arrUniques(1 To d1.Count) 
    For i = 1 To d1.Count 
     arrUniques(i) = Split(d1(i), ",")  'example: Array("1","2","9","4") 
    Next 
    ShowArray arrUniques, 2 
End Sub

Private Sub ShowArray(ByRef arr As Variant, ByVal arrId As Long) 
    Dim itm1 As Variant, itm2 As Variant, i As Long, j As Long 

    Debug.Print "Start array " & arrId & " --------" 
    For i = LBound(arr) To UBound(arr) 
     For j = LBound(arr(i)) To UBound(arr(i)) 
      Debug.Print "arr(" & i & ")(" & j & ") = " & arr(i)(j) 
     Next 
    Next 
    Debug.Print "End array " & arrId & " --------" & vbCrLf 
End Sub

输出：

Start array 1 -------- 
arr(0)(0) = 0 
arr(0)(1) = 0 
arr(0)(2) = 0 
arr(0)(3) = a 
arr(0)(4) = b 
arr(0)(5) = a 
arr(0)(6) = c 
arr(0)(7) = b 
arr(0)(8) = c 
arr(0)(9) = d 
arr(0)(10) = 0 
arr(0)(11) = 0 

arr(1)(0) = 0 
arr(1)(1) = 0 
arr(1)(2) = 0 
arr(1)(3) = 1 
arr(1)(4) = 2 
arr(1)(5) = 1 
arr(1)(6) = 9 
arr(1)(7) = 2 
arr(1)(8) = 9 
arr(1)(9) = 4 
arr(1)(10) = 0 
arr(1)(11) = 0 

arr(2)(0) = 0 
arr(2)(1) = 0 
arr(2)(2) = 0 
arr(2)(3) = r 
arr(2)(4) = g 
arr(2)(5) = r 
arr(2)(6) = w 
arr(2)(7) = g 
arr(2)(8) = t 
arr(2)(9) = w 
arr(2)(10) = 0 
arr(2)(11) = 0 
End array 1 --------

Start array 2 -------- 
arr(1)(0) = a 
arr(1)(1) = b 
arr(1)(2) = c 
arr(1)(3) = d 

arr(2)(0) = 1 
arr(2)(1) = 2 
arr(2)(2) = 9 
arr(2)(3) = 4 

arr(3)(0) = r 
arr(3)(1) = g 
arr(3)(2) = w 
arr(3)(3) = t 
End array 2 --------

（假设重复w在你的输出中是一个错误，正如评论中提到的那样）

从多维数组中获取唯一值

相关推荐