Excel VBA删除列表中的指定值

我有100行数据的列表，在这100行中有6个唯一值。 我试图运行一个for / next语句，从该列表中随机抽取一个值，然后删除与我拉的值匹配的100列表中的每行数据。 然后，我想在新的数据集上重复这个过程（例如，如果有100个项目的列表，并且其中14个表示“Apple”和Apple是返回值，我希望它删除所有的单元格说“苹果”，并在其余的86个单元上运行该过程）。 最终产品是一个随机排列的所有6个独特值的列表，没有重复

现在，我可以运行该过程的次数和一切正常，除了它将只在第一次通过删除单元格。 所以，如果我第一次拉“苹果”通过它将删除所有“苹果”的实例，但如果我第二次通过它拉橙色将不会删除所有“橙”的实例，因此，我可能再次拉“橙”，这会给我重复。

真的，我只是想弄清楚为什么删除最后一个唯一值的部分代码只能从第一行开始（下面的部分（'删除队列表中与选秀select相匹配的行）我想要实现的是将一个奇幻曲棍球选秀彩票的赔率（如此糟糕的球队有29％的几率首先挑选出来，他们在列表中列出了29个百分点）。必须重写将是伟大的一切我想要它的工作，除了一旦第一个唯一的价值从列表中拉出，我只剩下五个其他值，应该删除列表中的下一个select的代码部分第二次停止工作，提前谢谢。

这里是代码部分：

Dim TeamCount As Long, TeamPick As Range Dim DraftPick As Range, TeamList As Range, NonPlayoffTeams As Range Dim i As Integer, counter As Integer, counter1 As Integer Set TeamPick = Range("f4") Set NonPlayoffTeams = Range("b20:b25") i = 1 For counter = 1 To NonPlayoffTeams.Rows.Count 'count number of teams in list TeamCount = Application.WorksheetFunction.CountA(Range(Range("J2"), Range("J" & Rows.Count).End(xlUp))) 'pick a random number between 1 and count of teams listed and show that team name in that cell from the list TeamPick = Application.WorksheetFunction.Index(Range(Range("J2"), Range("J" & Rows.Count).End(xlUp)), Application.WorksheetFunction.RandBetween(1, TeamCount)) 'set the teamlist as the range of all the teams copied and pasted earlier Set TeamList = Range(Range("J2"), Range("J" & Rows.Count).End(xlUp)) ' delete rows in team list that match draft pick selection For counter1 = 1 To TeamList.Rows.Count If TeamList.Cells(i) = TeamPick Then TeamList.Cells(i).Delete Else i = i + 1 End If Next Set TeamPick = TeamPick.Offset(1, 0) Next 

Answer 1

我想要实现的是将一个奇幻曲棍球选秀彩票的赔率（如此糟糕的球队有29％的首选机率，他们在列表中列出了29个百分点）。

FWIW，我推荐一个更简单的方法，比列出队29次，然后删除所select的队的所有实例。 相反，你在标准化的累积概率数组中放置几率，从0到1之间select一个随机值，然后查找数组。 更新概率并重复。 您甚至可以在常规电子表格中执行此操作，而且根本不必使用VBA。

尝试这样的事情：

Answer 2

这会将所有值从A列复制到B列。 它删除B列中的所有重复项。 然后它随机化B列：

 Sub Main() Dim N As Long, InOut() As Variant Range("A:A").Copy Range("B1") ActiveSheet.Range("B:B").RemoveDuplicates Columns:=1, Header:=xlNo N = Cells(Rows.Count, "B").End(xlUp).Row ReDim InOut(1 To N) For I = 1 To N InOut(I) = Cells(I, "B").Value Next I Call Shuffle(InOut) For I = 1 To N Cells(I, "B").Value = InOut(I) Next I End Sub Public Sub Shuffle(InOut() As Variant) Dim 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