口算题随机出题vba代码

hb662868

vba代码需求：
1、从“口算题”工作表随机取60道题按20行3列排在“出题”工作表前三列
2、从“填空题”工作表随机取20道题按20行1列排在“出题”工作表第四列
3、从“连加连减”工作表随机取20道题按20行1列排在“出题”工作表第五列

liulang0808

论坛雷同案例很多的，楼主可以先检索参考下，另外附件模拟数据尽可能完善下

liulang0808

Private Sub CommandButton1_Click()
    Set d = CreateObject("scripting.dictionary")
    Set dd = CreateObject("scripting.dictionary")
    Set dc = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    Application.Intersect(ActiveSheet.UsedRange, Columns("a:e")).Offset(1).ClearContents
    arr = Sheets("填空题").[a1].CurrentRegion
    For j = 2 To UBound(arr)
        d(arr(j, 2)) = ""
    Next j
    arr = Sheets("连加连减").[a1].CurrentRegion
    For j = 2 To UBound(arr)
        dd(arr(j, 2)) = ""
    Next j
    arr = Sheets("口算题").[a1].CurrentRegion
    For j = 2 To UBound(arr)
        dc(arr(j, 2)) = ""
    Next j
    For j = 2 To 21
        If d.Count <> 0 Then
            x = WorksheetFunction.RandBetween(0, d.Count - 1)
            k = d.keys()(x)
            Cells(j, 4) = k
            d.Remove k
        End If
        If dd.Count <> 0 Then
            x = WorksheetFunction.RandBetween(0, dd.Count - 1)
            k = dd.keys()(x)
            Cells(j, 5) = k
            dd.Remove k
        End If
        For i = 1 To 3
            If dc.Count <> 0 Then
                x = WorksheetFunction.RandBetween(0, dc.Count - 1)
                k = dc.keys()(x)
                Cells(j, i) = k
                dc.Remove k
            End If
        Next i
    Next j
    Application.ScreenUpdating = True
End Sub

liulang0808

口算题随机出题.zip (23.79 KB, 下载次数: 28)

2024-2-7 07:51 上传

点击文件名下载附件

hb662868

liulang0808 发表于 2024-2-7 07:51

谢谢大神！

grf1973

直接用随机数生成20以内的加法不就行了，还用得着在题库里选吗？

grf1973

完全用随机数生成。

hb662868

grf1973 发表于 2024-2-7 11:26
完全用随机数生成。

哇，这个代码简洁而且逻辑简单，太牛了

grf1973

aa有RandBetween(a,19)更合理。
上一个JSA的版本，调了半天。

grf1973

VBA写成的习惯 if(j=3)，结果陷入死循环。应该是j==3