|
楼主 |
发表于 2014-10-5 15:36
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
核心代码如下:- Option Explicit
- Public Sub TianChong() '填充
- With 多边形
- If .Range("a2").Value = "" Then MsgBox "请输入顶点数!", , "友情提示": Exit Sub
- If Not (IsNumeric(.Range("a2").Value)) Then MsgBox "请输入数值!", , "友情提示": Exit Sub
- If .Range("a14").Value = "" Then MsgBox "请输入随机点数!", , "友情提示": Exit Sub
- If Not (IsNumeric(.Range("a2").Value)) Then MsgBox "请输入数值!", , "友情提示": Exit Sub
- .Range("d18:e" & Rows.Count).ClearContents
- Dim xx, yy, x#, y#, a#, b#, i&, j&, k&, n%, m&, xmin%, xmax%, ymin%, ymax%, sjd, t!
- t = Timer: k = 0
- n = .Range("a2").Value '顶点数
- m = .Range("a14").Value '随机点数
- xx = .Range("d2").Resize(n + 1)
- yy = .Range("e2").Resize(n + 1)
- xmin = WorksheetFunction.Min(xx): xmax = WorksheetFunction.Max(xx) '界定随机点产生的最大相关范围
- ymin = WorksheetFunction.Min(yy): ymax = WorksheetFunction.Max(yy)
- ReDim sjd(1 To m, 1 To 2) '存储符合要求的随机点
- For j = 1 To m
- 100:
- x = xmin + Rnd() * (xmax - xmin) '产生平面中的随机点
- y = ymin + Rnd() * (ymax - ymin)
- k = k + 1
- For i = 1 To n
- a = (x - xx(i, 1)) * (y - yy(i + 1, 1)) '计算叉积
- b = (x - xx(i + 1, 1)) * (y - yy(i, 1))
- If a - b <= 0 Then GoTo 100 '小于0时在多边形外,等于0在边上,大于0在内部
- Next i
- sjd(j, 1) = x: sjd(j, 2) = y
- Next j
- .Range("d18").Resize(m, 2) = sjd
- End With
- MsgBox "共尝试落点" & k & "次,命中率:" & Format(m / k, "0.00%") & ",用时:" & Format(Timer - t, "0.0000") & "秒。", , "友情提示"
- End Sub
复制代码 |
|