|
|
最近我用VBA模拟了怪物掉落（其实我的目的不是为了模拟掉落，而是为了设计物品的随机属性，模拟掉落没太大意义），熟悉VBA的同学如果感兴趣，大家可以共同研究下
在掉落表模式下，每个道具都有对应的权重，每次掉落检测就是按照权重随机选取一个道具
如果一个怪物一次掉落多个道具，游戏里分“所有的道具都不重复”和“道具允许重复”这两种情况
在数学上，这分别对应 无放回加权抽样 和 有放回加权抽样
我在excel里设计了两个自定义函数实现这个功能：
sample(range1,range2)和
sample_wor(range1,range2,range3)
其中range1引用某个excel表格区域，里面是道具名称或者序号列表
range2引用的某个excel表格区域，是对应的权重列表
以上两个变量在这两个函数里，含义相同
而第二个函数里的
range3引用的某个excel表格区域，是已经掉落的道具名称或者序号列，无放回抽样要求抽取出来的样本不能与它们冲突
如果某个道具对应的权重是0，代表这个道具无法掉落.
下面是VBA代码，但我感觉可能在运行效率上存在改良的余地，如果一次随机生成上万件道具的属性，速度会比较慢
Function Sample(ByVal range1 As Range, ByVal range2 As Range)
Dim array1 As Variant
Dim array2 As Variant
If range1.Rows.Count = 1 Then
ReDim array1(1 To range1.Columns.Count)
ReDim array2(1 To range2.Columns.Count)
j = 1
For i = 1 To range1.Columns.Count
If range2.Cells(1, i) = 0 Then
Else
array1(j) = range1.Cells(1, i)
array2(j) = range2.Cells(1, i)
j = j + 1
End If
Next
Else
ReDim array1(1 To range1.Rows.Count)
ReDim array2(1 To range2.Rows.Count)
j = 1
For i = 1 To range1.Rows.Count
If range2.Cells(i, 1) = 0 Then
Else
array1(j) = range1.Cells(i, 1)
array2(j) = range2.Cells(i, 1)
j = j + 1
End If
Next
End If
weight_sum = Application.WorksheetFunction.Sum(range2)
random_number = Int(weight_sum * Rnd() + 1)
i = 1
weight_subsum = array2(1)
Do While weight_subsum < random_number
i = i + 1
weight_subsum = weight_subsum + array2(i)
Loop
Sample = array1(i)
End Function
Function Sample_wor(ByVal range1 As Range, ByVal range2 As Range, ByVal range3 As Range)
Dim array1 As Variant
Dim array2 As Variant
If range1.Rows.Count = 1 Then
ReDim array1(1 To range1.Columns.Count)
ReDim array2(1 To range2.Columns.Count)
j = 1
For i = 1 To range1.Columns.Count
If range2.Cells(1, i) = 0 Or Isexist(range1.Cells(1, i), range3) Then
Else
array1(j) = range1.Cells(1, i)
array2(j) = range2.Cells(1, i)
j = j + 1
End If
Next
Else
ReDim array1(1 To range1.Rows.Count)
ReDim array2(1 To range2.Rows.Count)
j = 1
For i = 1 To range1.Rows.Count
If range2.Cells(i, 1) = 0 Or Isexist(range1.Cells(i, 1), range3) Then
Else
array1(j) = range1.Cells(i, 1)
array2(j) = range2.Cells(i, 1)
j = j + 1
End If
Next
End If
weight_sum = 0
For i = 1 To UBound(array2)
weight_sum = weight_sum + array2(i)
Next i
random_number = Int(weight_sum * Rnd() + 1)
i = 1
weight_subsum = array2(1)
Do While weight_subsum < random_number
i = i + 1
weight_subsum = weight_subsum + array2(i)
Loop
Sample_wor = array1(i)
End Function
Function Isexist(a, ByVal range1 As Range)
Arr = 0
For Each b In range1
If a = b.Value Then
Arr = Arr + 1
End If
Next
If Arr = 0 Then
Isexist = False
Else
Isexist = True
End If
End Function
|
|
发表于 2010-5-6 19:06:00
楼主