Question

欢迎！

我在准备函数或部分代码时遇到问题，该函数或部分代码对以下结构中的数据提供操作（这种格式的数据已存储在Array中）：

ID Flag Company
33 AB   67345
33 ABC  53245
33 C    67345
33 AB   25897
33 A    89217
33 BC   81237
33 B    89217
33 C    89217

该练习的目的是基于键ID + Company获得具有组合记录的新数组。所以基本上输出应该是：

33 ABC  67345
33 ABC  53245
33 AB   25897
33 ABC  89217
33 BC   81237

我尝试了几种解决方案，但仍未得到最终结果。我使用了循环或比较方法。

谁能提供至关重要的解决方案？此时，性能并不是关键，最重要的是可以解决此问题的解决方案。

我尝试过将值从Array移到另一个的解决方案，但是仍然出现重复行，例如：

33 ABC 89217
33 AB  89217
33 C   89217

代码示例：

   For i = 1 To UBound(Array1)
        If Array1(i, 13) <> "Matched" Then
            strTestCase = Array1(i, 1) & Array1(i, 9)
            strLegalEntityType = EntityFlag(Array1(i, 5))
                For j = 1 To UBound(Array1)
                            If Array1(j, 1) & Array1(j, 9) = strTestCase Then
                                    Array1(i, 13) = "Matched"
                            End If

                            If EntityFlag(Array1(i, 5)) = EntityFlag(Array1(j, 5)) Then
                                arrTemporary1(i, 5) = EntityFlag(Array1(j, 5)) & strLegalEntityType
                                arrTemporary1(i, 5) = funcRemoveDuplicates(arrTemporary1(i, 5))
                                 arrTemporary1(i, 1) = Array1(i, 1)
                                 arrTemporary1(i, 2) = Array1(i, 2)
                                 arrTemporary1(i, 3) = Array1(i, 3)
                                 arrTemporary1(i, 4) = Array1(i, 4)
                                 arrTemporary1(i, 6) = Array1(i, 6)
                                 arrTemporary1(i, 7) = Array1(i, 7)
                                 arrTemporary1(i, 8) = Array1(i, 8)
                                 arrTemporary1(i, 9) = Array1(i, 9)
                                 arrTemporary1(i, 10) = Array1(i, 10)
                                 arrTemporary1(i, 11) = Array1(i, 11)
                                 arrTemporary1(i, 12) = Array1(i, 12)

                                 a = a + 1

                             End If


            Next j
        End If
    Next i

Answer 1

这可以在Power Query（在Excel 2016+中也称为Get&Transform）中完成

通过ID =>“所有行”将行按ID和公司分组
添加一个自定义列以将结果表更改为列表：
- 自定义列的公式：Table.Column([Grouped],"Flag")
选择“自定义”列顶部的双向箭头，然后从列表中选择“提取”值，并使用“无”作为定界符

以上所有操作都可以在用户界面上完成（手动输入自定义列的公式），但这是生成的M代码：

let
    Source = Excel.CurrentWorkbook(){[Name="Table1"]}[Content],
    #"Changed Type" = Table.TransformColumnTypes(Source,{{"ID", Int64.Type}, {"Flag", type text}, {"Company", Int64.Type}}),
    #"Grouped Rows" = Table.Group(#"Changed Type", {"ID", "Company"}, {{"Grouped", each _, type table [ID=number, Flag=text, Company=number]}}),
    #"Added Custom" = Table.AddColumn(#"Grouped Rows", "Custom", each Table.Column([Grouped],"Flag")),
    #"Extracted Values" = Table.TransformColumns(#"Added Custom", {"Custom", each Text.Combine(List.Transform(_, Text.From)), type text})
in
    #"Extracted Values"

Answer 2

您可以使用字典来实现。要使用字典，您需要添加对Microsoft Scripting Runtime

的引用

Sub demo()
    Dim dict As New Scripting.Dictionary
    Dim arr As Variant
    Dim i As Long
    Dim tmpID As String
    Dim k
    Dim tmpFlag As String

    ' Set range to variant
    ' Update with your sheet reference and range location
    With ActiveSheet
        arr = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, 3))
    End With

    ' Loop through array
    For i = LBound(arr, 1) To UBound(arr, 1)
        ' Create composite ID of ID and Company
        tmpID = arr(i, 1) & "," & arr(i, 3)
        ' If it doesn't exist add to dictionary
        If Not dict.Exists(tmpID) Then
            dict.Add Key:=tmpID, Item:=arr(i, 2)
        ' If it does exist append value
        Else
            tmpFlag = StrConv(dict(tmpID) & arr(i, 2), vbUnicode)
            tmpFlag = Join(SortArrayAtoZ(Split(tmpFlag, Chr$(0), Len(tmpFlag))), "")
            dict(tmpID) = tmpFlag
        End If
    Next i

    ' Read back results
    ReDim arr(1 To dict.Count, 1 To 3)
    Dim arrCount As Long

    ' Debug.Print results can be viewed in the Immediate Window
    Debug.Print "ID", "Flag", "Company"
    For Each k In dict.Keys
        arrCount = arrCount + 1
        arr(arrCount, 1) = Split(k, ",")(0)
        arr(arrCount, 2) = dict(k)
        arr(arrCount, 3) = Split(k, ",")(1)
        Debug.Print Split(k, ",")(0), dict(k), Split(k, ",")(1)
    Next k

    ' Update with first cell of desired location of results
    With ActiveSheet
        .Cells(2, 5).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With

End Sub

Function SortArrayAtoZ(myArray As Variant)
    Dim i As Long
    Dim j As Long
    Dim Temp

    'Sort the Array A-Z
    For i = LBound(myArray) To UBound(myArray) - 1
        For j = i + 1 To UBound(myArray)
            If UCase(myArray(i)) > UCase(myArray(j)) Then
                Temp = myArray(j)
                myArray(j) = myArray(i)
                myArray(i) = Temp
            End If
        Next j
    Next i

    SortArrayAtoZ = myArray
End Function

匹配VBA数组值并覆盖重复项

2 个答案: