范围内所有最大值的VBA随机行

Question

这是我的第一篇文章，如果有什么可以澄清的，请告诉我。

我正在尝试在 Excel 中设置一个简单的词汇表。

这个想法是有 3 张纸，一张会显示语言 A 并要求用语言 B 回答， 另一个会反过来做，最后一张是两种语言中所有单词的列表。

WordList Sheet 有 4 列（Nr.、Lang.A、Lang.B、Rating），我的问题从这里开始。

现在我已经设置它在“LanguageSheet”上显示列表中的一个单词，您可以输入答案，我有一个用于 .OnKey 的宏，它在按下 Enter 键 (~) 时触发。

如果答案是正确的，它直接将这一行“Wordlist”表中“Rating”列的值减1，并选择一个新词。 如果答案是错误的，您可以按两个按钮之一“我的答案是正确的”，如果只是拼写错误或其他什么，或者“我的答案是错误的”点击“右键”也会将“评分”值降低 1并选择了一个新词，点击“错误按钮”将使“评分”增加 1 并选择一个新词。

现在我有这个 xls 的两个版本，一个版本只是选择列表中的一个随机单词，版本 2 是在 Rating 中寻找最大值并显示具有最大值的单词。

总的来说，第 2 版更接近我想要实现的目标，但目前存在一些问题。

它总是给我列表中评分最高的第一个词，通常有几个词具有相同的高评分。 如果选择的单词输入错误，它会再次显示相同的单词，因为它的“评分”值再次增加，直到评分低于其他一些。

我的目标：是检查“评分”列，并给我一个随机反馈给我一个评分最高的单词，例如。 15 个单词的评分为 5，然后给我这 15 个随机单词，而不仅仅是第一个单词。这将比当前版本更好，但仍然不理想，因为如果有一个词的评分较高，那么所有其他词都会一遍又一遍地重复，直到评分较低。如果可以避免一个单词立即重复，这个选项就可以了。

所以另一个想法是寻找 10 个（或有多少）评分最高的词（不需要是相同的评分，例如 6,6,5,4,... 等等）并询问他们随机顺序，但每个单词只有一次。回答完所有单词后，无论对错，它都会再次选择评分最高的 10 个单词，依此类推。但这里也不应该只选择评分最高的前 10 个词（在相同评分值的情况下），而是应该在所有评分相同的词中随机选择它们。

所以这是很多文字，请查看我目前所拥有的 OnKey 的宏：

Public sh As Worksheet, nr As Long, Mx As Long, rw As Long, Rng As Range

Option Explicit

Public Sub SetOnkey()

Application.OnKey "~", "UseOnkey"

End Sub
Public Sub UseOnkey()

If ActiveSheet Is Sheet3 Then

    If Range("C16") = "Right!" Then

        sh.Range("F" & rw).Value = sh.Range("F" & rw).Value - 1

        Cells(15, 3).Clear
        Cells(15, 3).Font.Size = 48

        Set Rng = sh.Range("F2:F351")   
        Mx = WorksheetFunction.Max(Rng)
        rw = WorksheetFunction.Match(Mx, Rng, 0) + Rng.Row - 1

        Range("C5") = sh.Range("D" & rw)

     End If

 ElseIf ActiveSheet Is Sheet1 Then

    If Range("C16") = "Right!" Then

        sh.Range("F" & rw).Value = sh.Range("F" & rw).Value - 1

        Cells(15, 3).Clear
        Cells(15, 3).Font.Size = 48

        Set Rng = sh.Range("F2:F351")   
        Mx = WorksheetFunction.Max(Rng)
        rw = WorksheetFunction.Match(Mx, Rng, 0) + Rng.Row - 1

        Range("C5") = sh.Range("B" & rw)

    End If


End If
End Sub

Public Sub UnsetOnkey()

Application.OnKey "~"

End Sub

我还有这个按钮：

Private Sub CommandButton1_Click()
Set sh = Sheets(3) 

Set Rng = sh.Range("F2:F351")   
    Mx = WorksheetFunction.Max(Rng)
    rw = WorksheetFunction.Match(Mx, Rng, 0) + Rng.Row - 1

    Range("C5") = sh.Range("D" & rw)

    Cells(15, 3).Clear
    Cells(15, 3).Font.Size = 48
End Sub

Private Sub CommandButton2_Click()

    sh.Range("F" & rw).Value = sh.Range("F" & rw).Value - 1

    Cells(15, 3).Clear
    Cells(15, 3).Font.Size = 48

    Set Rng = sh.Range("F2:F351")   
    Mx = WorksheetFunction.Max(Rng)
    rw = WorksheetFunction.Match(Mx, Rng, 0) + Rng.Row - 1

    Range("C5") = sh.Range("D" & rw)
End Sub

Private Sub CommandButton3_Click()

    sh.Range("F" & rw).Value = sh.Range("F" & rw).Value + 1

    Cells(15, 3).Clear
    Cells(15, 3).Font.Size = 48

    Set Rng = sh.Range("F2:F351")   
    Mx = WorksheetFunction.Max(Rng)
    rw = WorksheetFunction.Match(Mx, Rng, 0) + Rng.Row - 1

    Range("C5") = sh.Range("D" & rw)


End Sub

不幸的是，我在这方面不是很熟练，我只是对如何做事有一些基本的了解。

如果有任何悬而未决的问题或我需要更改任何内容，请告诉我。

Answer 1

毫无疑问，您的问题既庞大又多方面。请为将来制定问题，以便简明扼要地回答。我将解决避免重复的问题，并建议您创建一个这样的函数：-

Function WasAsked(NextWord As String) As Boolean
    ' 014
    ' this code requires a reference to 'Microsoft Scripting Runtime'

    Static Dict As Scripting.Dictionary

    If Dict Is Nothing Then Set Dict = New Scripting.Dictionary
    With Dict
        If .Exists(NextWord) Then
            WasAsked = True
        Else
            .Add NextWord, 0
        End If
    End With
End Function

这个想法是你创造一种方式来建议一个词（这是另一个主题，另一个问题）。然后你问这个函数是否之前问过这个词。如果函数返回 True (WasAsked = True)，您的另一个函数会选择另一个单词并提交。您的代码可能如下所示：-

Dim NextWord As String
Dim SkipWord As Boolean

Do 
    NextWord = SuggestAWord()          ' a function that returns a new word
    SkipWord = WasAsked(NextWord)
Loop While SkipWord

函数WasAsked 创建一个字典并将每个询问的单词添加到其中。该字典在会话期间保留在内存中。因此，在 Excel 关闭（或崩溃）之前，不能要求重复。您可以使用此代码测试该功能。

Private Sub TestWasAsked()
    Debug.Print WasAsked("Lion")
End Sub

第一次返回 False，之后每次返回 True。请记住在 VBE 工具菜单的引用列表中勾选对 Microsoft Scripting Runtime 的引用。更改参数（“Lion”）以向字典中添加更多单词。

我提请您注意函数中的这行代码。

.Add NextWord, 0

字典被设计成字典，意味着一个词与与该词相关的信息相匹配，例如翻译成另一种语言，或姓名和电话号码，物品和价格。目前我的功能只使用了它的一半能力——它的搜索能力。上面代码的关联值为0。将来你可能想记录翻译，然后可能使用同一个字典来询问另一种语言的相同单词。 - 只是说:-)