Question

我有以下示例数据：

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

我想要做的是建立一年内所有独特（不同）名称的列表。因此，例如在2016年，我希望它建立一个类似于最终结果列的列表，而在2017年，我希望它建立一个具有该年唯一名称的列表。

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

如果在动态命名范围内无法做到这一点，那么也可以将数组存储在VBA中。

我在网上看到了一些Excel公式，它们查看列表中的唯一值，但没有一个我可以找到额外的标准（在这种情况下：年）。

有人能让我走上正确的道路吗？

Answer 1

这是一个简短的VBA sub来实现你的要求。

要设置子版，请按Alt + F11打开VBA编辑器，然后按Insert＆gt; Module并粘贴以下代码。我评论过它以显示每个部分正在做什么。您也可以将此设置为在更改年份单元格时运行，但我会将其作为练习留给您！要运行它，请在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 + 输入输入公式。要查看所有结果，而不仅仅是第一个结果，请突出显示该单元格及其下方的5（例如），按 F2 进行编辑，然后按 Ctrl + Shift + 再次输入。

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

=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，并在两张图片中查看它的使用

：

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

将命名范围_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）作为示例。对你期望发生的所有年份都这样做。

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

4 个答案: