有没有一种简单的方法可以遍历此列表以防止重复选择？

Question

我今天花了几个小时思考如何解决这个问题。我在这里创建了一些简单的示例数据作为图像（我不太清楚如何放入表格）：

样本数据：这显示了数据处理的三个阶段

我的目标是遵循以下方针：我有很多人（最顶端有4人）。他们根据自己的喜好对8种水果和蔬菜排名1-8。然后，将人员（采摘者）放在一个列表中，根据他们的排名为他们分配池中剩余的排名最高的水果/蔬菜。

因此，例如，在第一名的汤姆（Tom）位居第一，他将苹果公司（Apple）排名第一，因此他将获得苹果公司的职位。安德鲁将获得之前未选择的最高排名的水果/蔬菜。我想自动执行“ pick”列中的填充。

我已经遍历这里和其他地方的问题，寻找类似的例子。我以为使用数组和索引+匹配可能可以解决这个问题，但是我真的无法提出一个可行的结构。我可以尝试在Excel之外的其他程序中处理此问题，但我认为这可能更让人头疼。

我认为也许通过宏或VBA可以解决某些问题，但是这有点超出我的能力了。有没有人对使用内置Excel工具如何实现此目标有任何想法？

关于发布的样本数据，我认为唯一可能的结果是选定的项目在被选中时被从列表中删除，但是我不包括在内，因为我不确定该怎么做。

这将是一次处理，但是在实际数据中，有数十个人具有数百个排名，因此要处理的清单很长。

我正在使用Excel 2016（16.0.11328.20420 64位）。

Answer 1

以不同的搜索顺序获取商品（如果不唯一的话）

基本上，您会按照从左到右的顺序搜索（从 Tom到Alex ），继续下一个排名行，但是一旦找到duplo，就会偏离当前的results中。

我演示了一种方法

• [1] 将完整的数据范围分配给2维数组data，
• [2] 遍历数据，搜索可以写入results数组的有效（即唯一）项（请参见[c]部分）；这些结果是通过[a]一个特殊的辅助函数getNextItem()和[b]使用Filter函数（False参数来删除所有当前发现的结果）发现的。
• [3] 最终将结果写回到工作表。

Sub PickNick()
    Const Tom = 1, Alex& = 4
  ' [0] temporary array with all available picks
    Dim tmp
    tmp = Array("Apple", "Banana", "Carrots", "Grapes", "Limes", "Orange", "Squash", "Tomatoes")
  ' [1] get data from sheet (via CodeName) & prepare results array
    Dim data:  data = Sheet1.Range("B3:E10")
    ReDim results(1 To UBound(data), 1 To 1)
  ' [2] Loop through data (rank 1-2 and every picker)
    Dim rnk&, picker&
    For rnk = 1 To 2
        For picker = Tom To Alex
          ' [a] get next (unique) item via function getNextItem (see below)
            Dim nxt: nxt = getNextItem(data, results, rnk, picker)
          ' [b] filter out next item (remove it from temp array)
            tmp = Filter(tmp, nxt, False, vbTextCompare)
          ' [c] note results in array pick
            results((rnk - 1) * Alex + picker, 1) = nxt
        Next picker
    Next rnk
  ' [3] write results back to sheet (start cell H3)
    Sheet1.Range("H3").Resize(UBound(data), 1) = results

End Sub

上述过程调用的辅助函数getNextItem()

Function getNextItem(data, results, rnk, picker)
' Purpose: get next unique item in data, i.e. the first occurrence in results
' Method:  if not unique check the following items in the pickers data column
' Note:    called in section [2a] of main procedure PickNick
    Dim FirstOccurrence
    Dim i&, nxt
    getNextItem = "?"                   ' provide for no result
    For i = rnk To UBound(results)
        nxt = data(i, picker)
        FirstOccurrence = IsError(Application.Match(nxt, Application.Transpose(results), False))
        If FirstOccurrence Then
            getNextItem = nxt             ' return next item as function result
            Exit Function
        End If
    Next i
End Function