数组内容随机排序问题请教

dsmch

找出最小值后，可以用下面的程序，增加了一句判断代码
Dim arr, d As Object
n = Val(InputBox("输入运行的次数"))
s = 10000
arr = Application.WorksheetFunction.Transpose(Range("b2:b16"))
For j = 1 To n
Set d = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
line1:
x = Int(Rnd * UBound(arr)) + 1
If Not d.exists(x) Then d.Add x, arr(x) Else GoTo line1
Next i
Range("c2").Resize(d.Count, 1) = Application.WorksheetFunction.Transpose(d.items)
Set d = Nothing
y = Range("f2")
If s > y Then m = s: s = y: y = m
If s < 1 Then Exit Sub '输入最小值，满足条件结束程序，这里设定为1
Next j
MsgBox "随机排列运行" & n & "次的最小值是：" & s

lanyf

原帖由 dsmch 于 2011-4-6 15:32 发表
找出最小值后，可以用下面的程序，增加了一句判断代码
Dim arr, d As Object
n = Val(InputBox("输入运行的次数"))
s = 10000
arr = Application.WorksheetFunction.Transpose(Range("b2:b16"))
For j = 1 To  ...

呵呵 谢谢 谢谢 就是上面的结果了
不过怎么记录所求最小值时的排列呢？该最小值的排列最前面的序号怎么对应呢？

dsmch

11楼代码，输入具体值替换1
If s < 1 Then Exit Sub '输入最小值，满足条件结束程序，这里设定为1

Zamyi

已改，见19楼。

[ 本帖最后由 Zamyi 于 2011-4-7 09:57 编辑 ]

lanyf

原帖由 dsmch 于 2011-4-6 16:07 发表
11楼代码，输入具体值替换1
If s < 1 Then Exit Sub '输入最小值，满足条件结束程序，这里设定为1

谢谢 谢谢了
采用上面随机排序
我试了下当循环99999次时，估计要十多分钟
能不能设计为像excel中排序一样呢
a数组中存放随机数，要排序的数组b按a数组中的内容升序，然后当更新a数组中的随机后，b数组再按a数组内容升序排列时，就满足随机排序了
这样速度会不会比较快呢~

lanyf

原帖由 Zamyi 于 2011-4-6 16:13 发表
Option Base 1
Public Sub tt()
Dim Min, Kmin
Dim a(15), b(15)
Const Ka = 0.20943951023932
For Each c In
  n = n + 1
  a(n) = c
  Next
Kmin = 1000
While m < 100000 And Kmin > 0.1
  tol = 15
...

谢谢帮助 谢谢
我运行了一下啊 倒数第二行的值是最后结果吗，运行结束的条件是什么呢 能说一下吗

dsmch

取消表格赋值，直接在代码中执行，满足结果再赋值。

dsmch

附件
Microsoft Excel.rar (8.81 KB, 下载次数: 23)

2011-4-6 16:50 上传

点击文件名下载附件

Zamyi

原来代码不对。试试下面：结果<0.001或者100W次没找到更小的结束。
Option Base 1
Public Sub tt()
Dim Min, Kmin
Dim a(15), b
Const Ka = 0.418879020478639
Const Ktime = 1000000
For Each c In [b2:b16]
  i = i + 1
  a(i) = c
  Next
Kmin = 1000
b = a
While Kmin > 0.001 And m < Ktime
  For i = 1 To 15
    t = Int((16 - i) * Rnd() + 1)
    te = b(t)
    b(t) = b(16 - i)
    b(16 - i) = te
    Next
  MinSin = 0
  MinCos = 0
  For i = 1 To 15
    MinSin = MinSin + b(i) * Sin(Ka * i)
    MinCos = MinCos + b(i) * Cos(Ka * i)
    Next
  Min = MinSin * MinSin + MinCos * MinCos

  If Min < Kmin Or m >= Ktime Then Kmin = Min: m = 0
  m = m + 1
Wend
[c2:c16] = Application.Transpose(b)
End Sub

Zamyi

恩，SIN应该以弧度为单位吧？D2=C2*SIN(PI()/7.5*(ROW()-2))。上面是随机取数，不如直接历遍求最值好。