Excel VBA第二次删除列表中的指定值答案

【问题标题】：Excel VBA Delete specified values in list on second go aroundExcel VBA第二次删除列表中的指定值
【发布时间】：2015-06-27 21:07:55
【问题描述】：

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

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

真的，我只是想弄清楚为什么删除从剩余行列表中提取的最后一个唯一值的代码部分仅在第一次运行时有效（下面的部分（'删除团队列表中与草稿匹配的行选择）。我想要实现的是将赔率纳入梦幻曲棍球选秀彩票中（所以最差的球队有 29% 的机会获得第一顺位，他们在列表中的 100 次中列出了 29 次）。任何限制的提示我必须重写多少会很棒。我希望它工作的一切，除了从列表中拉出第一个唯一值并且我只有剩余的五个其他值，即应该从中删除下一个选择的代码部分该列表第二次停止工作。提前谢谢你。

这里是代码部分：

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

【问题讨论】：

标签： vba excel for-loop

【解决方案1】：

这会将列 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

【讨论】：

我不想删除重复项。我想从 100 个列表中选择一个，将该选择添加到单独的列表中，然后从原始列表中删除该唯一值，然后重复。例如，假设我有一个包含 10 个项目的列表，这十个项目说“苹果”、“香蕉”或“梨”。首先，它必须说 Apple 5 次、Banana 3 次和 Pear 两次。我随机挑选一件，说是梨。然后我想删除梨的所有实例。所以我应该留下一个 8 个列表，上面写着苹果 5 次和香蕉 3 次。我想在新列表上重复这个过程。

【解决方案2】：

我想要实现的是将赔率纳入梦幻曲棍球选秀彩票中（所以最差的球队有 29% 的机会总体上是第一顺位，他们在 100 个名单中被列出了 29 次）。

FWIW，我推荐一种比列出团队 29 次然后删除所选团队的所有实例更简单的方法。取而代之的是，您在归一化累积概率数组中布置赔率，在 0 和 1 之间选择一个随机值，然后对数组进行查找。更新概率并重复。您甚至可以在常规电子表格中执行此操作，并且可能根本不需要使用 VBA。

试试这样的：

【讨论】：