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

Question

我正在写一本问题的书，我试图让excel处理很多肮脏的工作。除了最后一部分之外，我还完成了许多其他部分，我希望在其中填写选项：H列中已有1个字（H2：H13）。我用vlookup函数返回它。我从字的其余部分（H2：H13）得到三个其他随机唯一值。 这里是我的excel是什么样子：

正如你可以在图片中看到，我需要从J18字不同的细胞K18，L18和M18（红方）三个随机唯一值。 在此先感谢。

Answer 1

随着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. 不需要
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 

喜光电池K18通过M18，然后单击公式栏。然后输入数组公式：

=xclude(J18,H2:H13) 

数组公式必须按Ctrl +移输入 + 输入，而不仅仅是输入键。如果这样做是正确的，公式栏中的公式将以花括号显示。

Answer 2

这里的另一个solution done with Googledocs

它涉及到使用JOIN，SPLIT，RANDBETWEEN，地址，行的，间接的，IF，左，右，替代品，REPT这是一个反复的过程，除去一个逗号分隔列表（值分隔符由B4驱动，确保它是你的数据不包含的字符）。基本上每次你选择一个随机值从选择中删除它。所以第一次10个可能性，第二次，9个可能性，第三次8等等...

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

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