1

应用户的要求，我用更多信息重写了这个问题，并尽可能地澄清它。

我有将范围读入数组的代码。执行许多计算。结果数组包含一个 ID 和两个值：

ID   Seq   Value
a    1     100
a    2     150
a    3     200
b    1     10
b    2     10
b    3     10

但是，计算步骤使用Redim Preserve，所以我必须将数组存储为TestArray(1 To 3, 1 To 6).

我需要过滤数组中的重复 ID。

如果没有重复，我需要存储id、seq和value。

如果有重复的 ID，我需要存储 ID、seq 和 value，其中 value 是给定 ID 的最大值。

如果有重复的 ID 并且有多个最大值实例，我想保留 ID、日期和值，其中 value 是给定 ID 的最大值，seq 是给定 ID 的最小 seq。

基本上，对于每个 ID，我想要最大值，如果有多个最大值，则默认为最早的序列号。

这是一个代码示例，显示了数组的结构以及我需要的结果是什么样的。

Sub TestArray()

  Dim TestArray() As Variant
  Dim DesiredResults() As Variant

  TestArray = Array(Array("a", "a", "a", "b", "b", "b"), _
    Array(1, 2, 3, 1, 2, 3), _
    Array(100, 150, 200, 10, 10, 10))
  DesiredResults = Array(Array("a", "b"), Array(3, 1), Array(200, 10))

End Sub

有没有办法遍历数组并找到重复项然后比较它们？我可以在 SQL 中轻松做到这一点，但我在 VBA 中苦苦挣扎。

4

1 回答 1

5

我保留了我的测试代码，以便您可以检查结果并进行尝试。我评论了为什么正在做某些事情-希望它有所帮助。

返回数组以 1 为底，格式为 (column, row)。你当然可以改变这个。

Option Explicit

Public Sub TestProcess()

    Dim testResults
    testResults = GetProcessedArray(getTestArray)
    With ActiveSheet
        .Range( _
            .Cells(1, 1), _
            .Cells( _
                1 + UBound(testResults, 1) - LBound(testResults, 1), _
                1 + UBound(testResults, 2) - LBound(testResults, 2))) _
            .Value = testResults
    End With

End Sub

Public Function GetProcessedArray(dataArr As Variant) As Variant

    Dim c As Collection
    Dim resultsArr
    Dim oldResult, key As String
    Dim i As Long, j As Long, lb1 As Long

    Set c = New Collection
    lb1 = LBound(dataArr, 1) 'just cache the value of the lower bound as we use it a lot

    For j = LBound(dataArr, 2) To UBound(dataArr, 2)

        'extract current result for the ID, if any
        '(note that if the ID's aren't necessarily the same type you can add
        ' the key with  prefix of VarType or TypeName as something like key = CStr(VarType(x)) & "|" & CStr(x))
        key = CStr(dataArr(lb1 + 0, j))
        On Error Resume Next
        oldResult = c(key)

        If Err.Number = 5 Then 'error number if record does not exist

            On Error GoTo 0
            'record doesn't exist so add it
            c.Add Array( _
                key, _
                dataArr(lb1 + 1, j), _
                dataArr(lb1 + 2, j)), _
                key

        Else

            On Error GoTo 0
            'test if new value is greater than old value
            If dataArr(lb1 + 2, j) > oldResult(2) Then
                'we want the new one, so:
                'Collection.Item reference is immutable so remove the record
                c.Remove key
                'and Add the new one
                c.Add Array( _
                    key, _
                    dataArr(lb1 + 1, j), _
                    dataArr(lb1 + 2, j)), _
                    key
            ElseIf dataArr(lb1 + 2, j) = oldResult(2) Then
                'test if new sequence number is less than old sequence number
                If dataArr(lb1 + 1, j) < oldResult(1) Then
                    'we want the new one, so:
                    'Collection.Item reference is immutable so remove the record
                    c.Remove key
                    'and Add the new one
                    c.Add Array( _
                        key, _
                        dataArr(lb1 + 1, j), _
                        dataArr(lb1 + 2, j)), _
                        key
                End If
            End If

        End If

    Next j

    'process results into the desired array format
    ReDim resultsArr(1 To 3, 1 To c.Count)
    For j = 1 To c.Count
        For i = 1 To 3
            resultsArr(i, j) = c(j - LBound(resultsArr, 2) + 1)(i - LBound(resultsArr, 1))
        Next i
    Next j

    GetProcessedArray = resultsArr

 End Function

Private Function getTestArray()

  Dim testArray() As Variant
  Dim flatArray
  Dim i As Long
  ReDim flatArray(0 To 2, 0 To 5)

  testArray = Array( _
    Array("a", "a", "a", "b", "b", "b"), _
    Array(1, 2, 3, 1, 2, 3), _
    Array(100, 150, 200, 10, 10, 10))

  For i = 0 To 5

    flatArray(0, i) = testArray(0)(i)
    flatArray(1, i) = testArray(1)(i)
    flatArray(2, i) = testArray(2)(i)

  Next i

  getTestArray = flatArray

End Function
于 2013-08-27T20:04:44.843 回答