如何用VBA编写抽样调查的程序

Question

大家好！有个技术问题请教：1. excel表格中有5000条记录，两列，家庭编号和年收入. 2. 希望能够用VBA编一个代码（.xlsm)使用户能进行抽样调查，就是从这5000条记录中决定样本大小(变量m)3. 然后随机抽取m个样本（不重复抽取同一样本）4. 算出这m个随机抽取的样本的平均值。大家觉得这个代码应该如何编写？谢谢。

Answer 1

use table
copy stru to mytable
public lnrecno(m+1)
sele 1
use mytable
sele 2
use table
for i=1 to m
lnrecno(i+1)=int(rand()*m)
if lnrecno(i+1)=lnrecno(i)
return
endif
go lnrecno(i+1)
scatt to lashuzu
sele 2
grat from lashuzu
endif

Answer 2

jxjdzwang5555，高手。对于VBA，我十分初哥，但是我还是努力编了个代码，因为这是我的作业，不过我已经退掉那个课了，但是还是把未完成的代码贴出来跟您和Demanding的Kill2010分享一下，这个代码不成功，如哪位大虾能指出错误就好了，因为红色代码那一段出现“运行时错误，6，溢出”，肯定是incomeTotal = incomeTotal + income(i)和sampleTotal = sampleTotal + income(i)出现了问题：Option ExplicitOption Base 1
Sub UserInput()
Dim random() As Integer
Dim income() As Currency
Dim i As Integer
Dim nHouseholds As Integer
Dim isValid As Boolean
Dim m As String
Dim nthValue As Integer
Dim incomeAvg As Integer
Dim incomeTotal As Integer
Dim sampleTotal As Integer
Dim sampleAvg As Integer'Clear old results
With Range("C1")
    Range(.Offset(1, 0), .End(xlDown)).ClearContents
    Application.ScreenUpdating = True
End With' Find the number of households, and redimension the arrays, and fill them with the data in the lists.With Range("B1")
    nHouseholds = Range(.Offset(1, 0), .End(xlDown)).Rows.Count
    ReDim income(nHouseholds)
    ReDim random(nHouseholds)
    For i = 1 To nHouseholds
        income(i) = .Offset(i, 0).Value
        'Generate some random # from 1 to 5000 to each household's income
        .Offset(i, 1).Value = WorksheetFunction.RandBetween(1, 5000)
        random(i) = .Offset(i, 1).Value
        Next
End With
    
'Get a sample size from the user.
 m = InputBox("Please enter a sample size (a number ranging from 2 to 4,999) less than 5,000 which is the total number of households.")
 Do
    isValid = True
    If Not IsNumeric(m) Then
        isValid = False
    Else
        If Int(m) <> m Or m < 2 Or m > 4999 Then
            isValid = False
        End If
    End If
    Loop Until isValidWith Range("B1")
    incomeTotal = 0
        For i = 1 To nHouseholds
            incomeTotal = incomeTotal + income(i)
            Next
        For i = 1 To nHouseholds
                If random(i) <= m Then
                sampleTotal = sampleTotal + income(i)
                sampleAvg = sampleTotal / 5000
            End If
        Next
        
 End With
 
 'Output
 MsgBox "The average income of all households is " & incomeAvg & ". The average income of sample size is " & sampleAvg & " ."
 End Sub

Answer 3

分 3 步：
1 采用随机发生器产生抽样总数，10%--30%左右吧 ，称 m
2 使用随机发生器产生 m 个数填充一个数组Row(0 to m-1), 数组元素内容是行号，范围 1--5000.
3 按行号读取对应行的数据参与统计OK 了。