首页 > 解决方案 > 在公共元素上组合数组

问题描述

我有两个相同的多维数组,其中包含Date Hour Value一系列日期的元素。每个系列中可能存在缺失值。

我想使用DateHour作为键组合成一个数组:
Date Hour Value from array1 Value from array2

目前我的方法是根据最早/最新日期创建一个新数组,然后用每个数组中的值填充,但想知道是否有更好/更简单的方法。

标签: arraysexcelvba

解决方案


请尝试下一种方法。以下代码从 Excel 工作表加载包含时间、小时和值的数组,涉及的范围如下所示:

涉及范围

两个范围“A2:C6”和“F2:F6”将分别加载到两个二维数组(arr1arr2)中。它们将被处理并将处理结果放入arrFin. 范围“J2:K8”代表处理结果:

Sub testMatchDayHourValue()
 Dim sh As Worksheet, arr1, arr2, arrFin, i As Long
 Dim dict As New Scripting.Dictionary
 
 Set sh = ActiveSheet      'use here your necessary sheet
 arr1 = sh.Range("A2:C6").Value 'put the range value in an array
 arr2 = sh.Range("F2:H6").Value 'put the range value in an array
 For i = 1 To UBound(arr1) 'iterate through the first array elements and create uniques keys
    If Not dict.Exists(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) Then
        dict.Add arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm"), arr1(i, 3) 'the key and its initial value
    Else
        'add to existing value the new one, for the same existing key:
        dict(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) = _
              dict(arr1(i, 1) & " " & Format(arr1(i, 2), "hh:mm")) + arr1(i, 3)
    End If
 Next
 For i = 1 To UBound(arr2) 'iterate through the second array elements, create uniques keys and add values
    If Not dict.Exists(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) Then
        dict.Add arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm"), arr2(i, 3) 'create a key if it not existing
    Else
        'add to existing value the new one, for the same existing key:
        dict(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) = _
            dict(arr2(i, 1) & " " & Format(arr2(i, 2), "hh:mm")) + arr2(i, 3)
    End If
 Next
 'combining the arrays in the final one, using a not well known method:
 arrFin = Application.Transpose(Array(dict.Keys, dict.Items))

 'drop the created array contents at once:
 sh.Range("J2").Resize(UBound(arrFin), 2).Value = arrFin
End Sub

请测试我建议的方式并发送一些反馈。


推荐阅读