excel随机抽样问题 就是现在有八个同学的成绩，抽取其中三个，列出放回和不放回抽样的所有可能性.

发布网友 发布时间：2022-04-29 19:27

我来回答

共1个回答

热心网友 时间：2023-10-06 04:38

抽样放不放回去都是56组。

Sub 抽样()

Dim Yb(1 To 10000, 1 To 10), Bh(1 To 10, 1 To 10), Gd(1 To 3), A, N, M, X
    Range(Cells(2, 4), Cells(60000, 7)) = ""
    For i = 1 To 8
        Bh(i, 1) = i
        Bh(i, 2) = Cells(i + 1, 2)
        Bh(i, 3) = "N"
    Next
   
    For i = 1 To 8000
        X = 0
        For j = 1 To 3
line1:
            A = Int(Rnd() * 8 + 1)
            For k = 1 To 8
                If Bh(k, 1) = A And Bh(k, 3) = "Y" Then GoTo line1
                If Bh(k, 1) = A And Bh(k, 3) = "N" Then
                    Bh(k, 3) = "Y"
                    X = X + 1
                    If X = 3 Then N = N + 1
                    Gd(X) = Bh(k, 2)
                    Exit For
                End If
            Next
        Next
        '写入抽样样本
        If X = 3 Then
            M = M + 1
            For j = 1 To 3
                Yb(N, j) = Gd(j)
                Gd(j) = ""
            Next
            '样本排序
            For j = 1 To 2
                For k = j + 1 To 3
                    If Yb(N, k) < Yb(N, j) Then
                        Ty = Yb(N, j): Yb(N, j) = Yb(N, k): Yb(N, k) = Ty
                    End If
                Next
            Next
            Yb(N, 4) = Yb(N, 1) * 10000 + Yb(N, 2) * 100 + Yb(N, 3)
            '****************************************
            'B=2 是样本不放回去，B=1是样本放回去
            '****************************************
            B = 2
            If M = B Then
                M = 0
                For k = 1 To 8
                    Bh(k, 3) = "N"
                Next
            End If
        End If
    Next
   
    '样本组合排序
    For i = 1 To N - 1
        For j = i + 1 To N
            If Yb(j, 4) < Yb(i, 4) Then
                Ty = Yb(i, 4): Yb(i, 4) = Yb(j, 4): Yb(j, 4) = Ty
                For k = 1 To 3
                    Ty = Yb(i, k): Yb(i, k) = Yb(j, k): Yb(j, k) = Ty
                Next
            End If
        Next
    Next
   
    '删除重复样本
    For i = 1 To N - 1
        If Yb(i, 5) <> "×" Then
            For j = i + 1 To N
                If Yb(j, 4) = Yb(i, 4) Then Yb(j, 5) = "×"
            Next
        End If
    Next
   
    M = 0
    For i = 1 To N
        If Yb(i, 5) = "" Then
            M = M + 1
            For j = 1 To 3
                Yb(M, j) = Yb(i, j)
            Next
        End If
    Next
   
    For i = 1 To M
        For j = 1 To 3
            Cells(i + 1, j + 3) = Yb(i, j)
        Next
    Next
   
End Sub