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

我正在写一本关于问题的书,而我正在努力使excel处理很多肮脏的工作。 我完成了除了最后一部分之外的许多事情,我希望excel能够填充选项:H列(H2:H13)中已有1个字。 我用vlookup函数返回它。 我需要从字的其余部分(H2:H13)其他三个随机的唯一值。 这是我的Excel的样子: Excelscrshot

正如你在图像中看到的那样,我需要三个与J18中的单词不同的单元格K18,L18和M18(红色正方形)的随机唯一值。 提前致谢。

H2H13的数据中,在I2I13中input:

 =RAND() 

然后在J18M18中input:

 =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. 在标准模块中input以下内容:

 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 

高亮度单元格K18M18 ,然后单击公式栏。 然后input数组公式:

 =xclude(J18,H2:H13) 

数组公式必须使用Ctrl + Shift + Enterinput,而不仅仅是Enter键。 如果这样做是正确的,公式栏中的公式将在其周围显示大括号。

这是使用Googledocs完成的另一个解决scheme

它包括使用JOIN,SPLIT,RANDBETWEEN,ADDRESS,ROW,INDIRECT,IF,LEFT,RIGHT,SUBSTITUTE和REPT这是一个迭代过程,从逗号分隔列表中删除一个值(分隔符由B4驱动,确保它是一个字符你的数据不包含)。 基本上每次你select一个随机值从select中删除它。 所以第一次10个可能性,第二次,9可能性,第三次8等等…

经修订的V2:在B4中使用SEPARATOR字符,甚至更多地使用SUBSTITUTE。 (减less额外的中间步骤与IF公式复制跨列然后重组)。 结果: 结果 配方在这里输入图像描述

感谢之前的回复,但我不得不通过代码来争取我想要的结果。 我在App Inventor中使用这些块编码了类似的结构(我希望所有的语言都有一个块),所以我把我的代码翻译成了VBA。 以下是有人可能使用它的解决scheme:

 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