excel中随机不重复选取指定区域单元格内容

Question

我有49万的单元格数据，在2003版excel中占用了从A1到S25200和T1到T11200，想要从中随机不重复的选取70%或其他比例的单元格内容，在后面的列中输出，求VB命令。
是否可以选中多列随机不重复抽取，遇到空白跳过？
求高手给出具体的VBA命令

Answer 1

如果不讲究技巧，可以用死办法：
Sub R_DATA()
Dim Data_Range As Range
Dim sht As Worksheet
Dim p, t, Data_Count, RND_r, RND_c
p = 0.7 ' 指定比例
t = Application.WorksheetFunction.CountA("A1:T25200") ' 统计数据个数

Set Data_Range = Range("A1:T25200") ' 指定源数据区域
Set sht = Worksheets("Sheet2") ' 指定取出随机数的保存工作表

Do While Data_Count < Round(t * p, 0) ' 当取值计数小于指定比例时循环
RND_c = Int(Rnd() * 20 + 1) ' 随机取行坐标
RND_r = Int(Rnd() * 25200 + 1) ' 随机取列坐标
If sht.Cells(RND_r, RND_c) <> 1 And Cells(RND_r, RND_c) <> "" Then ' 判断是否已经取值、是否为空值
sht.Cells(RND_r, RND_c) = Cells(RND_r, RND_c) ' 取值保存在Sheet2表的同一位置
Data_Count = Data_Count + 1 ' 取值计数加1
End If
Loop
End Sub

说明，由于EXCEL版本是2003，最多65536行。从49万个数据中取70%，那么【后面的列】是不可能保存得下的。因此代码中将这些数据存放在另外的工作表Sheet2中，位置与原表相同。

Answer 2

试试这段代码，运行效率还可以：

Sub test()
Dim dic As Object, newarr(), i&, i1&, c%
p = 0.7 '取数比例
c = 20000 '新表列数

Set dic = CreateObject("Scripting.Dictionary")

arr = Sheets("Sheet1").Range("A1:T25200").Value '取数范围

For Each tmp In arr
If Not (dic.exists(tmp)) Then dic(tmp) = ""
Next

dic.Remove ""
arr = dic.keys
Set dic = Nothing

num = UBound(arr)
c = Application.WorksheetFunction.Min(c, num + 1)
num1 = Int(p * (num + 1))
ReDim newarr(c - 1, Int(num1 / c))

For i = 0 To num1 - 1
i1 = Round(Rnd * num, 0)
newarr(i Mod c, Int(i / c)) = arr(i1)
arr(i1) = arr(num)
num = num - 1
Next

Sheets(2).[a1].Resize(c, Int(num1 / c) + 1) = newarr

End Sub本回答被提问者和网友采纳

Answer 3

你的数据区域不好计算总个数，且按你所说，还有空单元格，那么你的70%可能是你实际有数据单元格的超过70%的数量了。
给你个思路，把两个区域分别赋值给两个数组，然后，把两个数据循环把不是空白的赋值给一个一维数组，在用这个一维数组来循环给出结果（用字典来判断随机数）追问

那如果我把前几列的单元格都填充满，就是A到G列是满的，H列到31248这样可以直接选？

追答

一样得按以上思路转换一下。