楼主
northwolves |
Q:您有多富？
A: 使用下面的函数计算一下即可:
- Sub 您有多富()
- Getit InputBox("请输入你的年收入(美元)", "提示", 6000)
- End Sub
- Sub Getit(ByVal myincome As Long) 'Input
- 'myincome = myincome * 0.145465 ' RMB to USD
- Dim i As Long, bindex As Long, sumx As Double, sumy As Double, sumxy As Double, sumx2 As Double
- Dim people, money, slope As Double, intb As Double, pos, percent, msg As String
- If myincome < 100 Then pos = 5780722892#: percent = 99.9: GoTo showmsg
- If myincome > 200000 Then pos = 107565: percent = 0.001: GoTo showmsg
- people = Array(0, 600000, 1200000, 3000000, 4500000, 5100000, 5395000, 5700000, 5940000, 5999990)
- money = Array(50, 400, 500, 850, 1486.67, 2182.35, 25000, 33700, 47500, 202000)
- bindex = WorksheetFunction.Match(myincome, money, 1) - 1
- sumx = people(bindex) + people(bindex + 1)
- sumy = money(bindex) + money(bindex + 1)
- sumxy = people(bindex) * money(bindex) + people(bindex + 1) * money(bindex + 1)
- sumx2 = people(bindex) ^ 2 + people(bindex + 1) ^ 2
- slope = (2 * sumxy - sumx * sumy) / (2 * sumx2 - sumx ^ 2)
- intb = (sumy - slope * sumx) / 2
- pos = Round(6000000000# - ((myincome - intb) / slope) * 1000, 0)
- percent = Format((pos / 6000000000#) * 100, "0.00")
- showmsg:
- msg = "您目前年收入 " & myincome & " 美元！" & vbCrLf & vbCrLf
- msg = msg & "您在全球财富排行榜排名 " & pos & " 位！" & vbCrLf & vbCrLf
- msg = msg & "您属于全球 " & percent & "% 最富有的人！" & vbCrLf & vbCrLf
- msg = msg & Right(Space(200) & "阁下", 2 * Round(100 - percent, 0)) & vbCrLf & Right(Space(200) & "↓", 2 * Round(100 - percent, 0)) & vbCrLf
- msg = msg & String(100, "*") & vbCrLf
- msg = msg & "<--穷极→→→→→→→→→→→→→--全球人口 →→→→→→→→→→→→-富极-->"
- MsgBox msg, , "您有多富?"
- End Sub
|