Excel从值列表中向相邻单元格返回4个随机唯一值

Question

我正在写一本问题书，而我正试图让excel处理大部分肮脏的工作。我完成了许多事情，除了最后一部分，我想要excel填充选择：H列中已有1个单词（H2：H13）。我用vlookup函数返回它。我从单词栏的其余部分（H2：H13）中获得了其他三个随机唯一值。 这是我的excel的样子：

正如您在图像中看到的，我需要三个随机唯一值，用于与J18中的单词不同的单元格K18，L18和M18（红色方块）。 提前谢谢。

Answer 1

这是另一个solution done with Googledocs

它涉及使用JOIN，SPLIT，RANDBETWEEN，ADDRESS，ROW，INDIRECT，IF，LEFT，RIGHT，SUBSTITUTE和REPT这是一个迭代过程，从逗号分隔列表中删除一个值（分隔符由B4。确保它是您的数据不包含的字符。基本上每次选择随机值时都会从选择中删除它。所以第一次有10个可能性，第二次，9个可能性，第三次8个等等...

已修改V2：在B4中使用SEPARATOR char并使用SUBSTITUTE甚至更多。 （减少额外的中间步骤，使用IF公式复制列然后重新组合）。 的结果： 的公式：

Answer 2

数据在 H2 到 H13 ，在 I2 到 I13 中输入：

=RAND()

然后在 J18 到 M18 输入：

=INDEX($H$2:$H$13,RANK(I2,$I$2:$I$13,1)+COUNTIF($I$2:I2,I2)-1)  
=INDEX($H$2:$H$13,RANK(I3,$I$2:$I$13,1)+COUNTIF($I$2:I3,I3)-1)  
=INDEX($H$2:$H$13,RANK(I4,$I$2:$I$13,1)+COUNTIF($I$2:I4,I4)-1)  
=INDEX($H$2:$H$13,RANK(I5,$I$2:$I$13,1)+COUNTIF($I$2:I5,I5)-1)

修改＃1：

1. 这是 VBA 方法
2. ＆＃34;帮助＆＃34; 我列不需要
3. 在标准模块中输入以下内容：




Dim ary()


Sub Shuffle(InOut() As Variant)
    Dim HowMany As Long, i As Long, J As Long
    Dim tempF As Double, temp As Variant

    Hi = UBound(InOut)
    Low = LBound(InOut)
    ReDim Helper(Low To Hi) As Double
    Randomize

    For i = Low To Hi
        Helper(i) = Rnd
    Next i


    J = (Hi - Low + 1) \ 2
    Do While J > 0
        For i = Low To Hi - J
          If Helper(i) > Helper(i + J) Then
            tempF = Helper(i)
            Helper(i) = Helper(i + J)
            Helper(i + J) = tempF
            temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = temp
          End If
        Next i
        For i = Hi - J To Low Step -1
          If Helper(i) > Helper(i + J) Then
            tempF = Helper(i)
            Helper(i) = Helper(i + J)
            Helper(i + J) = tempF
            temp = InOut(i)
            InOut(i) = InOut(i + J)
            InOut(i + J) = temp
          End If
        Next i
        J = J \ 2
    Loop
End Sub

Public Function Xclude(rX As Range, rng As Range) As Variant
    Application.Volatile
    Dim v As Variant, N As Long, i As Long
    v = rX.Text
    N = rng.Count
    i = 1

    For Each r In rng
        v2 = r.Text
        If v <> v2 Then
            ReDim Preserve ary(1 To i)
            ary(i) = v2
            i = i + 1
        End If
    Next r

    Call Shuffle(ary)

    Xclude = ary
End Function

Hi-light细胞 K18 至 M18 ，然后单击公式栏。然后输入数组公式：

=xclude(J18,H2:H13)

必须使用 Ctrl + Shift + 输入输入

数组公式，而不仅仅是 Enter 键。如果这样做正确，公式将在公式栏中以大括号显示。

Answer 3

感谢之前的回复，但我不得不通过代码争取我想要的结果。我使用块在App Inventor中编写了类似的结构（我希望所有语言都有一个块），所以我将我的代码翻译成了VBA。以下是有人可能使用它的解决方案：

Option Base 1
Function RSec(rng As Range, kactane As Integer, Optional exclude As String = "NoneX")
'rng is the source, kactane shows how many items to return, optional exclude will be excluded if supplied)


'lng holds the number of items in the supplied range
Dim lng As Integer
'listholder will hold everything in range
Dim listholder As New Collection
'chosen is the final list that will provide the randomly selected items
Dim chosen As New Collection
'Ranno is the random number for list index
Dim RanNo As Integer
'result is the array to return values to cells
Dim result() As String


'1- Add all items in range to listholder
For i = 1 To rng.Count
listholder.Add rng.Item(i).Value
Next i
'2- print listholder length for debug purposes
'Debug.Print "Listholder uzunluğu:"; listholder.Count

'set lng to listholdercount
lng = listholder.Count

'set a random number
Randomize
RanNo = Int((lng - 1 + 1) * Rnd + 1)

'main loop to choose kactane number of items
For k = 1 To kactane

'check if exclude parameter is present
    'if exclude parameter is not present, then choose randomly without checking
    If exclude = "NoneX" Then
        'add the randomly selected to the collection chosen
        chosen.Add listholder(RanNo)
        'remove the randomly selected from the list
        listholder.Remove (RanNo)
        'update the lng count
        lng = listholder.Count
    Else
       'if exclude parameter is present and randomly selected item is equal to exclude
        If listholder(RanNo) = exclude Then
        'decrement the k value to repeat this step and choose another item
        k = k - 1

        'if exclude parameter is present but not equal to the randomly chosen
        Else
                'seçileni chosen'a ekle
        chosen.Add listholder(RanNo)
        'orjinal listeden çıkar
        listholder.Remove (RanNo)
        'lng'yi güncelle
        lng = listholder.Count
        End If
    End If

're set to a new random number
Randomize
RanNo = Int((lng - 1 + 1) * Rnd + 1)
Next k

'set the size of the array
ReDim result(chosen.Count)

'push everything in collection to array
For rd = 1 To chosen.Count
result(rd) = chosen(rd)
Next rd

'return result
RSec = result

End Function