Question

请参阅图片。我试图返回与数组中重复单元格对应的值==>水平。因此，查找的第一个实例在列E中进行，第二个实例在列F中，在G中进行第三次；等等。我可以使用数组公式来处理少量数据：

重复数组公式

但这是问题所在。

使用5、10或15,000+行的数组公式需要花费大量时间。 是否有VBA解决方案按列返回与数组中重复单元格相对应的值？

Answer 1

我肯定有非常出色的VBA解决方案，但是为什么不跳过所有这些并在数据透视表中完成呢？

提供您的数据：

其中附加字段“列1”是根据公式

构建的

="Payment_" & COUNTIF($A$2:A2,A2)

“总结为数据透视表”很简单：

Answer 2

好的，这是我午饭时做的一些vba代码。在不到一秒钟的时间内执行超过5000条记录。

您将需要进行一定程度的自定义，以设置工作簿中的源位置和目标位置。

Sub vbaJaggedPivot()


    'replace the Range with however you want to define your source range.
    SourceData = Range(Cells(2, 1), Cells(5000, 2))

    'set up a dictionary object  We'll collect the row's name as key, and use a collection of payments for the item
    Dim dict As Object
    Set dict = CreateObject("Scripting.Dictionary")

    'Iterate over the spreadsheet range
    For i = 1 To UBound(SourceData)

        'add a new dictionary key and instantiate a payment collection for it if we haven't seen the current name before
        If Not dict.Exists(SourceData(i, 1)) Then
            Set paymentCol = New Collection
            paymentCol.Add SourceData(i, 2)

            dict.Add SourceData(i, 1), paymentCol

        Else

            'if we have this key, add the payment to the corresponding payment collection
            dict(SourceData(i, 1)).Add (SourceData(i, 2))
        End If


    Next i


    'identify the top left of the output area
    Dim targetRow, targetCol
    targetRow = 1
    targetCol = 5

    'some temporary placeholders for within the loop
    Dim tempArray() As Variant
    Dim key

    'iterate over the dictionary keys
    For i = 0 To dict.Count - 1

        'write out the key value to the output area
        key = dict.Keys()(i)
        Cells(targetRow + i, targetCol) = key

        'convert our collections to arrays, as these can be output with better peformance
        '      (* a 2D array would have been best, but the jagged nature of the data makes this awkward)
        ReDim tempArray(dict(key).Count - 1)
        For j = 0 To dict(key).Count - 1
            tempArray(j) = dict(key)(j + 1)
        Next j

        'write the payments out to the appropriate rows
        Range(Cells(targetRow + i, targetCol + 1), Cells(targetRow + i, targetCol + j)) = tempArray


    Next i



End Sub

如何从重复的VBA水平返回查找的值[pic]

2 个答案: