如何使用两个条件（数组公式[pref]或VBA）基于数据构建数组

Question

我有以下示例数据：

第一列是名称列表，第二列是这些名称所属的年份。

我想做的是建立一年内所有唯一（不同）名称的列表。 因此，例如在2016年，我希望它像最终结果列中那样建立一个列表，而在2017年，我希望它用该年的唯一名称来建立一个列表。

优选地，我希望它是一个（动态）命名范围，这样计算只需要执行一次，这样我就可以使用=INDEX(examplenamedrange, 1)公式调用要使用的名称。

如果在动态命名范围中不可能做到这一点，那么也可以将阵列存储在VBA中。

我在网上看到了一些Excel公式，这些公式查看列表中的唯一值，但是使用附加条件（在本例中为Year）找不到任何Excel公式。

谁能让我走上正确的道路？

Answer 1

这是实现您要求的简短VBA子。

要设置子项，请按Alt + F11打开VBA编辑器，然后依次单击“ Insert >“ Module并粘贴以下代码。 我已对其进行评论，以显示每个部分的功能。 您还可以将其设置为在Year单元格更改时运行，但是我将保留它作为练习！ 要运行它，请在VBA编辑器中按F5或单击运行按钮。

Sub uniqueInYear()

    Dim sh As Worksheet
    Set sh = ActiveSheet

    Dim vcell As Range

    Dim namesString As String
    namesString = ""

    Dim namesList() As String

    ' Compile string with all names comma separated for given year
    For Each vcell In Range("A2:A" & sh.UsedRange.Rows.Count)

        ' check if name already captured for given year
        If InStr(namesString, vcell.Value) = 0 And vcell.Offset(0, 1).Value = sh.Range("E1").Value Then

            namesString = namesString & "," & vcell.Value

        End If

    Next vcell

    ' If empty then quit
    If namesString = "" Then
        Exit Sub
    End If

    ' Remove leading comma
    namesString = Right(namesString, Len(namesString) - 1)

    ' Put names into array
    namesList = Split(namesString, ",")

    ' Write names to result column after clearing it
    sh.Range("E2:E" & sh.UsedRange.Rows.Count + 1).Value = ""

    Dim nameVar As Variant
    For Each nameVar In namesList

        sh.Range("E" & sh.UsedRange.Rows.Count + 1).End(xlUp).Offset(1, 0).Value = nameVar

    Next nameVar

    ' Named range - delete if it exists then create a-fresh
    On Error Resume Next
    sh.Parent.Names("UniqueNames").Delete
    On Error GoTo 0

    sh.Parent.Names.Add name:="UniqueNames", _
                        RefersTo:=sh.Range("E2", sh.Range("E" &     sh.UsedRange.Rows.Count + 1).End(xlUp))

End Sub

结果：

Answer 2

您可以尝试以下方法：

Sub Names()
    Dim x, Years, Counted, ColumnCount, j, lColumn
    Dim Names(), FoundNames()
    Years = Range("B1").Value
    Counted = 0
    ColumnCount = 2
    ReDim Names(Range("A" & Rows.count).End(xlUp).row)
    ReDim FoundNames(LBound(Names) To UBound(Names))
    lColumn = Cells(1, Cells(1, Columns.count).End(xlToLeft).Column).Column
    For Each c In Range(Range("A1"), Range("A" & Rows.count).End(xlUp))
        If Years <> Range("B" & c.row).Value Then
            For i = LBound(Names) To UBound(Names)
                If Names(i) <> "" Then
                    j = j + 1
                    FoundNames(j - 1) = Names(i)
                End If
            Next i
            ReDim Preserve FoundNames(LBound(Names) To j - 1)
            Cells(1, lColumn + ColumnCount).Value = Years
            For i = LBound(FoundNames) To UBound(FoundNames)
                Cells(i + 2, lColumn + ColumnCount).Value = FoundNames(i)
            Next
            ColumnCount = ColumnCount + 1
            Years = Range("B" & c.row).Value
            Counted = 0
            ReDim Names(Range("A" & Rows.count).End(xlUp).row)
            ReDim FoundNames(LBound(Names) To UBound(Names))
        End If

        If InStr(Join(Names, ","), c.Value) < 1 Then
            Names(Counted) = c.Value
            Counted = Counted + 1
        End If
    Next c
    j = 0
    For i = LBound(Names) To UBound(Names)
        If Names(i) <> "" Then
            j = j + 1
            FoundNames(j - 1) = Names(i)
        End If
    Next i
    ReDim Preserve FoundNames(LBound(Names) To j - 1)
    Cells(1, lColumn + ColumnCount).Value = Years
    For i = LBound(FoundNames) To UBound(FoundNames)
        Cells(i + 2, lColumn + ColumnCount).Value = FoundNames(i)
    Next
End Sub

结果看起来像这样：

Answer 3

只是在其中添加另一个类似但不同的方法。 您可以使用返回数组的UDF。 因此，将代码粘贴到代码模块中，然后在工作表上使用以下公式

=GetNamesInYear(names,dates,2016)

其中names是您的名称范围， dates是您的日期范围，而2016是您搜索的年份，可以使用公式中编写的数字或引用值为2016的单元格。

要返回完整的数组，您需要使用Ctrl + Shift + Enter输入公式。 要查看所有结果，而不仅仅是第一个结果，请突出显示该单元格及其下方的5（例如），按F2键进行编辑，然后再次按Ctrl + Shift + Enter 。

或者，您可以使用任何可以处理字符串数组的工作表函数来访问该数组。 例如：

=INDEX(GetNamesInYear(names,dates,2016),2)

返回数组中的第二项

---

这是代码

Function GetNamesInYear(names As Range, years As Range, year As Integer) As Variant
    Dim namesArr As Variant
    namesArr = names.Value2

    Dim yearsArr As Variant
    yearsArr = years.Value2

    Dim results As Long
    results = 0

    Dim resultArr As Variant
    Dim i As Long

    ReDim resultArr(0 To 0)
    For i = 1 To UBound(namesArr, 1)
        If Not InArray(resultArr, namesArr(i, 1)) And (yearsArr(i, 1) = year) Then
            ReDim Preserve resultArr(0 To results)
            resultArr(results) = namesArr(i, 1)
            results = results + 1
        End If
    Next i

    GetNamesInYear = Application.WorksheetFunction.Transpose(resultArr)
End Function

Private Function InArray(arr As Variant, value As Variant) As Boolean
    Dim i As Integer
    For i = 0 To UBound(arr)
        If arr(i) = value Then
            InArray = True
            Exit Function
        End If
    Next i
    InArray = False
End Function

结果看起来像这样：

更新资料
现在按照OP中的注释将名称和日期输入分开（分开的范围）

Answer 4

数组公式可以在这里工作：

=INDEX($A$1:$A$15, N(IF({1}, MODE.MULT(IF(($B$1:$B$15=2016)*(ROW($A$1:$A$15)=MATCH($A$1:$A$15, $A$1:$A$15, 0)), (ROW($A$1:$A$15)) * {1,1})))))

将命名范围定义为dynaRange_2016，并在两个图像中看到它的使用

：

您可以改为为每年命名一个范围，然后为唯一性范围定义另一个名称。 这更加通用：

将命名范围range_2017定义为=INDEX(Sheet5!$A:$A, MATCH(2017,Sheet5!$B:$B, 0)):INDEX(Sheet5!$A:$A, MATCH(2017,Sheet5!$B:$B, 1))

然后将另一个命名的范围uniques_2017定义为=INDEX(Sheet5!range_2017, N(IF({1}, MODE.MULT(IF(ROW(Sheet5!range_2017)-MATCH(2017, Sheet5!$B:$B, 0)+1=MATCH(Sheet5!range_2017, Sheet5!range_2017, 0), (ROW(Sheet5!range_2017)-MATCH(2017, Sheet5!$B:$B, 0)+1) * {1,1})))))

例如，在工作表中，您可以调用INDEX（uniques_2017，3）。 对您希望发生的所有年份执行相同的操作。