VBA随机抽取

Sub 随机挑选演示程序1()

Dim arr

Dim x As Integer, num As Integer, k As Integer

Range('c1:c10') = ''

Range('a1:a10') = Application.Transpose(Array('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J'))

For x = 1 To 10

num = (Rnd() * (10 - 1) + 1) \ 1

Range('a1:a10').Interior.ColorIndex = xlNone

Range('a' & num).Interior.ColorIndex = 6

Range('c' & x) = Range('a' & num)

Next x

End Sub

Sub 移形换位演示程序()

Dim arr

Dim x As Integer, num As Integer, k As Integer, sr As String

Range('c1:c10') = ''

Range('a1:a10') = Application.Transpose(Array('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J'))

For x = 1 To 10

num = (Rnd() * ((10 - x + 1) - 1) + 1) \ 1

Range('a1:a' & (10 - x + 1)).Interior.ColorIndex = xlNone

Range('a' & num).Interior.ColorIndex = 6

Range('c' & x) = Range('a' & num)

'下面开始换位

sr = Range('a' & num)

Range('a' & num) = Range('a' & (10 - x + 1))

Range('a' & (10 - x + 1)) = sr

Range('a' & (10 - x + 1)).Interior.ColorIndex = 1

Next x

End Sub

Sub 随机抽取字典法()

Dim d As Object

Dim arr, num As Integer, x As Integer, arr1(1 To 20000, 1 To 1) As String, t

t = Timer

Set d = CreateObject('scripting.dictionary')

arr = Range('a1:a20000')

For x = 1 To 20000

100:

num = Rnd() * (20000 - 1) + 1

If d.exists(num) Then

GoTo 100

Else

d(num) = ''

arr1(x, 1) = arr(num, 1)

End If

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[d65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub

'提速依据

'在换位时数字的换位速度要比文本型要快。所以借力数值型数组达到提速的目的

Sub 移形随机排序()

Dim arr

Dim arr1(1 To 20000, 1 To 1) As String, sr As String

Dim x As Integer, num, t

t = Timer

arr = Range('a1:a20000')

For x = 1 To UBound(arr)

num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1

arr1(x, 1) = arr(num, 1)

'换位

sr = arr(num, 1)

arr(num, 1) = arr(20000 - x + 1, 1)

arr(20000 - x + 1, 1) = sr

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[d65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub

Sub 移形随机排序升级()

Dim arr

Dim arr1(1 To 20000, 1 To 1) As String, sr As Integer

Dim x As Integer, num, t, y

Dim arr2(1 To 20000)

t = Timer

arr = Range('a1:a20000')

For y = 1 To 20000

arr2(y) = y

Next y

For x = 1 To UBound(arr)

num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1

arr1(x, 1) = arr(arr2(num), 1)

'换位

sr = arr2(num)

arr2(num) = arr2(20000 - x + 1)

arr2(20000 - x + 1) = num

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[F65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub

Sub 随机挑选演示程序1()

Dim arr

Dim x As Integer, num As Integer, k As Integer

Range('c1:c10') = ''

Range('a1:a10') = Application.Transpose(Array('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J'))

For x = 1 To 10

num = (Rnd() * (10 - 1) + 1) \ 1

Range('a1:a10').Interior.ColorIndex = xlNone

Range('a' & num).Interior.ColorIndex = 6

Range('c' & x) = Range('a' & num)

Next x

End Sub

Sub 移形换位演示程序()

Dim arr

Dim x As Integer, num As Integer, k As Integer, sr As String

Range('c1:c10') = ''

Range('a1:a10') = Application.Transpose(Array('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'I', 'J'))

For x = 1 To 10

num = (Rnd() * ((10 - x + 1) - 1) + 1) \ 1

Range('a1:a' & (10 - x + 1)).Interior.ColorIndex = xlNone

Range('a' & num).Interior.ColorIndex = 6

Range('c' & x) = Range('a' & num)

'下面开始换位

sr = Range('a' & num)

Range('a' & num) = Range('a' & (10 - x + 1))

Range('a' & (10 - x + 1)) = sr

Range('a' & (10 - x + 1)).Interior.ColorIndex = 1

Next x

End Sub

Sub 随机抽取字典法()

Dim d As Object

Dim arr, num As Integer, x As Integer, arr1(1 To 20000, 1 To 1) As String, t

t = Timer

Set d = CreateObject('scripting.dictionary')

arr = Range('a1:a20000')

For x = 1 To 20000

100:

num = Rnd() * (20000 - 1) + 1

If d.exists(num) Then

GoTo 100

Else

d(num) = ''

arr1(x, 1) = arr(num, 1)

End If

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[d65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub

'提速依据

'在换位时数字的换位速度要比文本型要快。所以借力数值型数组达到提速的目的

Sub 移形随机排序()

Dim arr

Dim arr1(1 To 20000, 1 To 1) As String, sr As String

Dim x As Integer, num, t

t = Timer

arr = Range('a1:a20000')

For x = 1 To UBound(arr)

num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1

arr1(x, 1) = arr(num, 1)

'换位

sr = arr(num, 1)

arr(num, 1) = arr(20000 - x + 1, 1)

arr(20000 - x + 1, 1) = sr

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[d65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub

Sub 移形随机排序升级()

Dim arr

Dim arr1(1 To 20000, 1 To 1) As String, sr As Integer

Dim x As Integer, num, t, y

Dim arr2(1 To 20000)

t = Timer

arr = Range('a1:a20000')

For y = 1 To 20000

arr2(y) = y

Next y

For x = 1 To UBound(arr)

num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1

arr1(x, 1) = arr(arr2(num), 1)

'换位

sr = arr2(num)

arr2(num) = arr2(20000 - x + 1)

arr2(20000 - x + 1) = num

Next x

Range('c1:c20000') = ''

Range('c1:c20000') = arr1

[F65536].End(xlUp).Offset(1, 0) = Timer - t

End Sub


相关文章

  • Access编程入门

    • 支持 / Access / 访问 2007年帮助和操作方法 / 宏与可编程性 是 Access 编程新手吗?请从这里开始 适用于: Microsoft Office Access 2007 在创建新数据库时,您通常首先创建几个数据库对象(如 ...查看


  • 语言文字信息处理整理

    • 一. 1. 2. 3. 4. 5. 6. 7. 8. 9. 10.填空选择目前计算机系统的工作原理是由冯·诺依曼提出来的.在微型计算机存储器中,不能修改其存储内容的是ROM .HTTP 是一种超文本传输协议.Symbian 操作系统属于嵌入 ...查看


  • Workbooks对象的Open方法的帮助说明(VBA)

    • http://www.excelpx.com/home/show.aspx?id=11569&cid=15 [日期:2008-11-23] 来源:  作者: [字体:大 中 小] 下面的这些内容,在Excel的VBA帮助中可以找到, ...查看


  • 窗体_报表_VBA

    • 窗体/报表/VBA 1． 窗体.报表.控件属性 窗体:名称,标题(caption),图片(picture), 默认视图,记录选择器,导航按钮,分隔线,最大化.最小化按钮,关闭按钮,允许添加记录 记录源(recordsource), 控件:名 ...查看


  • 2.1随机抽样

    • 第二章 统 计 §2.1 随机抽样 [入门向导] 2008年8月8日举世瞩目的北京奥运会开幕了! 新华网北京8月10日电,国际奥委会新闻发言人吉赛尔·戴维斯今天说,8亿4千万中国电视观众收看了北京奥运会开幕式,这个收视率令人惊讶． 据CMS ...查看


  • 高中数学名校导学案必修3

    • 必修三 1.1 从普查到抽样―――1.2.1简单随机抽样(学案) 一.读一读 学习目标:1.理解普查的意义及弊端:理解随机抽样的必要性和重要性. 2.理解并掌握简单随机抽样中的抽签法和随机数法. 二.试一试 (1)认真阅读教材P3-P6,完 ...查看


  • 抽样方法教案

    • 教学过程 一.复习预习 我们生活在一个数字化的时代,时刻都在与数据打交道,比如产品的 合格率,电视台的收视率等,你知道这些数据是怎么来的吗?实际上它们是通过调查获得的,怎样调查呢?是对考察对象进行全面的调查吗?很明显,这个既不可能,也没有必 ...查看


  • 2.1.1简单随机抽样教案

    • 2.1.1 简单随机抽样 一.三维目标: 1.知识与技能: 正确理解随机抽样的概念,掌握抽签法.随机数表法的一般步骤: 2.过程与方法: (1)能够从现实生活或其他学科中提出具有一定价值的统计问题: (2)在解决统计问题的过程中,学会用简单 ...查看


  • 湖北省恩施巴东县第一高级中学高中数学 §2.1.2系统抽样教案 新人教A版必修3

    • §2.1.2 系统抽样 一.教材分析 教材通过探究"学生对教师教学的意见"过程,介绍了一种最简单的系统抽样--等距抽样,并给出实施等距抽样的步骤． 值得注意的是在教学过程中,适当介绍当 二.教学目标 1.知识与技能: ( ...查看


热门内容