有莫得人帮忙写一下

弄成这样

dd

往下翻，昨天我发了个红包算法，没人回复，已沉

Option Explicit
Private Type RedPackage
RemainSize As Integer
remainMoney As Double
End Type
Private m_redPackage As RedPackage
Public Property Get RemainSize() As Integer
RemainSize = m_redPackage.RemainSize
End Property
Public Function SetRedPackage(RemainSize As Integer, remainMoney As Double)
m_redPackage.remainMoney = remainMoney
m_redPackage.RemainSize = RemainSize
End Function
Public Function GetRandomMoney() As Double
If m_redPackage.RemainSize = 1 Then
m_redPackage.RemainSize = 0
GetRandomMoney = CDbl(Round(m_redPackage.remainMoney * 100) / 100)
Exit Function
End If
Dim min As Double, max As Double, money As Double
min = 0.01
max = m_redPackage.remainMoney / m_redPackage.RemainSize * 2
Randomize
money = Rnd() * max
money = IIf(money <= min, 0.01, money)
money = Int(money * 100) / 100
m_redPackage.RemainSize = m_redPackage.RemainSize - 1
m_redPackage.remainMoney = m_redPackage.remainMoney - money
GetRandomMoney = money
End Function

packs = 10 '红包个数
money = 100 '总金额
r.SetRedPackage packs, money
这个是设置红包
If r.RemainSize Then
抽到的钱= r.GetRandomMoney
End If
这是抽红包，点一下就抽一个红包，直到抽完为止