1

ユーザーのリクエストに応じて、この質問をより多くの情報で書き直し、可能な限り明確にしようとしました.

範囲を配列に読み込むコードがあります。多くの計算が実行されます。結果の配列には、ID と 2 つの値が含まれます。

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、および値を保存する必要があります。

重複する ID がある場合は、ID、seq、および値を格納する必要があります。値は、特定の ID の最大値です。

重複する ID があり、最大値のインスタンスが複数ある場合、値が特定の ID の最大値であり、seq が特定の ID の最小 seq である ID、日付、および値を保持したいと考えています。

基本的に、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 です。もちろん、これを変更できます。

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 に答える