时间戳

首页 > 解决方案 > VBA锯齿状数组重复

arrays - VBA锯齿状数组重复

问题描述

我是使用 VBA 编码的新手，也是一般的初学者程序员。我有以下简单的表格（数据每天都在输入，所以它会改变）：

物品 ＃ 描述 日期 地点 盘子 加载 类型 速度 成本
0001 DES1 21 年 1 月 30 日 地点 ABC123 5 一 类型 1 100
0002 DES2 21 年 1 月 30 日 办公室 ACB465 4 一 类型 1 100
0003 DES3 21 年 1 月 30 日 办公室 ABC789 3 一 类型 1 100
0004 DES4 21 年 1 月 30 日 地点 ABS741 5 一 类型 1 100
0005 DES4 21 年 1 月 31 日 办公室 ABC852 2 一 类型 1 100

我想先按特定日期过滤此数据，然后在为所述重复项添加负载的同时删除位置中的重复项。

例如，如果我想过滤30/1/21。最终结果如下：

地点 加载
地点 10
办公室 7

然后我想把它放在一个摘要单元格中，如下所示：

概括
10个站点，7个办公室

我能够将原始表过滤成锯齿状数组。代码是：

For j = numberSkipD To numberRowsD
    If Worksheets("Disposal Fees").Range("F" & j).Value = Worksheets("Daily Tracking").Range("B2").Value Then
        For k = numberDisposalInformationRaw To numberDisposalLocation
            ReDim Preserve disposalLocation(numberDisposalLocation)
            disposalLocation(numberDisposalLocation) = Worksheets("Disposal Fees").Range("I" & j).Value
 
        Next
        numberDisposalLocation = numberDisposalLocation + 1
 
        For k = numberDisposalInformationRaw To numberDisposalLoad
            ReDim Preserve disposalLoad(numberDisposalLoad)
            disposalLoad(numberDisposalLoad) = Worksheets("Disposal Fees").Range("K" & j).Value
        Next
        numberDisposalLoad = numberDisposalLoad + 1
    End If
Next

然后我尝试做上面的第二个表（删除重复项并将所述重复项的值添加在一起）但它给了我错误，不知道如何解决它们。我知道它们是索引错误，但不知道如何修复它们。（请帮助我完成这部分，这是代码）

Dim disposalInformationRaw As Variant
    Dim disposalInformationCooked As Variant
    Dim FoundIndex As Variant, MaxRow As Long, m As Long
        
    ReDim disposalInformationCooked(1 To UBound(disposalInformationRaw, 1), 1 To UBound(disposalInformationRaw, 2))
    
    MaxRow = 0
    For m = 1 To UBound(disposalInformationRaw, 1)
        FoundIndex = Application.Match(disposalInformationRaw(m, 1), Application.Index(disposalInformationCooked, 0, 1), 0)

        If IsError(FoundIndex) Then
            MaxRow = MaxRow + 1
            FoundIndex = MaxRow
            disposalInformationCooked(FoundIndex, 1) = disposalInformationRaw(m, 1)
        End If

        disposalInformationCooked(FoundIndex, 2) = Val(disposalInformationCooked(FoundIndex, 2)) + Val(disposalInformationRaw(i, 2))
    Next m
    
    Range("G1").Resize(MaxRow, UBound(disposalInformationCooked, 2)).Value = disposalInformationCooked

我认为我在完成第三部分（摘要）时不会遇到太多麻烦，但是如果您知道如何做，请随时分享您将如何处理它。我主要需要第二部分的帮助。如果需要，我将非常乐意编辑并提供更多信息。提前致谢。

标签： arraysexcelvbaduplicatesjagged-arrays

解决方案

这是使用字典的一种方法。

dim dict, rw as range, locn, k, msg, theDate

set dict= createobject("scripting.dictionary")

theDate = Worksheets("Daily Tracking").Range("B2").Value

'adjust table range as required
for each rw in worksheets("Disposal Fees").range("F6:K100").rows
   if rw.cells(3).Value = theDate Then              'date match?
       locn = rw.cells(4).Value                     'read location
       dict(locn) = dict(locn) + rw.cells(6).Value  'add load to sum
   end if
next rw

'loop over the dictionary keys and build the output
for each k in dict
    msg = msg & IIf(len(msg) > 0, ", ", "") & dict(k) & " " & k
next k

debug.print msg

推荐阅读