EXCEL 表格 平行四边形内统计多少个点

hhjjpp

microyip 发表于 2016-10-19 12:07
题目明明写这“平行四边形”

平行四边形是四边形的特例，既然满足任意凸四边形（下图所谓两三角形）范围的落点判定，自然就满足了平行四边形的要求，意思是超出了楼主的要求

microyip

hhjjpp 发表于 2016-10-19 14:16
平行四边形是四边形的特例，既然满足任意凸四边形（下图所谓两三角形）范围的落点判定，自然就满足了平行 ...

凸四边形，但不一定是顶点的5点组成的四边形，现状不固定喔，很难说散点一定在不在四边形里喔，可以说在也可以不在哦。

hhjjpp

microyip 发表于 2016-10-19 14:37
凸四边形，但不一定是顶点的5点组成的四边形，现状不固定喔，很难说散点一定在不在四边形里喔，可以说在 ...

随便试试，随便改坐标数据就可知效果

crazy0qwer

hhjjpp 发表于 2016-10-19 15:32
随便试试，随便改坐标数据就可知效果

如果有边和Y轴平行，你的TREND就会返回错误的数据。因为没有对应的Y值。
另外 这个公式也无法区分点在线上的情况。

=IF(C14,AND(MEDIAN(TREND(D$6:D$7,C$6:C$7,C14),TREND(D$8:D$9,C$8:C$9,C14),D14)=D14,MEDIAN(TREND(D$7:D$8,C$7:C$8,C14),TREND(D$9:D$10,C$9:C$10,C14),D14)=D14),"")
TREND在这个公式里的作用就是：生成经过指定两点的直线方程式，然后求出这个直线上指定X坐标对应的Y坐标。
MEDIAN为求中值的公式，作用是判断点的Y坐标是否在两边与经过该点的竖线的两个交点之间，如图。
整个公式意思：需要判断的点分别在两组对边的中间即为在四边形内，即：
F 与B、E点
F 与C、D点
如果F在B、E点之间且在C、D点之间则为在内。
有兴趣可以自己分析下要判断的点如果在五个不同区域时的情况就能理解了。


如果边与Y轴平行 则公式失效。

microyip

1. Sub 计算()
   
2. Dim iDataSlope As Double, iStartSlope As Double, iEndSlope As Double
   
3. Dim vDot As Variant, iDot As Integer, vDataDot As Variant, iDataDot As Integer
   
4. Dim bIn As Boolean, vInout As Variant
   
5. 
   
6. vDot = [C6:D10].Value
   
7. vDataDot = [C14].Resize([C65536].End(xlUp).Row - 13, 2).Value
   
8. ReDim vInout(1 To UBound(vDataDot), 1 To 1)
   
9. 
   
10. For iDataDot = 1 To UBound(vDataDot)
    
11. bIn = True
    
12. For iDot = 2 To 4
    
13. iDataSlope = 斜率弧度(Val(vDot(iDot, 1)), Val(vDot(iDot, 2)), Val(vDataDot(iDataDot, 1)), Val(vDataDot(iDataDot, 2))) '顶点到散点的射线
    
14. iStartSlope = 斜率弧度(Val(vDot(iDot, 1)), Val(vDot(iDot, 2)), Val(vDot(iDot - 1, 1)), Val(vDot(iDot - 1, 2))) '顶点到上一个定点的射线边
    
15. iEndSlope = 斜率弧度(Val(vDot(iDot, 1)), Val(vDot(iDot, 2)), Val(vDot(iDot + 1, 1)), Val(vDot(iDot + 1, 2))) '顶点到下一个定点的射线边
    
16. iEndSlope = iEndSlope - (iEndSlope < iStartSlope) * Application.Pi() * 2 '如果第二条边的斜率弧度小于第一条边的斜率弧度，以转一圈的弧度计算
    
17. bIn = bIn And iDataSlope >= iStartSlope And iDataSlope <= iEndSlope
    
18. Next
    
19. vInout(iDataDot, 1) = IIf(bIn, "In", "Out")
    
20. Next
    
21. [E14].Resize(UBound(vInout), 1) = vInout
    
22. End Sub
    
23. 
    
24. Function 斜率弧度(iStartX As Double, iStartY As Double, iEndX As Double, iEndY As Double) As Double
    
25. If iStartX = iEndX Then
    
26. If iStartY = iEndY Then
    
27. 斜率弧度 = 0
    
28. ElseIf iStartY < iEndY Then
    
29. 斜率弧度 = Application.Pi() / 2
    
30. Else
    
31. 斜率弧度 = Application.Pi() * 3 / 2
    
32. End If
    
33. Else
    
34. 斜率弧度 = Atn((iEndY - iStartY) / (iEndX - iStartX)) - (iEndX - iStartX < 0) * Application.Pi() + (iEndX - iStartX > 0) * (iEndY - iStartY < 0) * Application.Pi() * 2
    
35. End If
    
36. End Function

复制代码

microyip

附上附件以供参考

crazy0qwer

计算有多少个点落入多边形V1.rar (19.72 KB, 下载次数: 11)

2016-10-20 08:04 上传

点击文件名下载附件

点在线上也算在四边形内。坐标最多两位小数。

1. Private Type POINTAPI
   
2.         X As Long
   
3.         Y As Long
   
4. End Type
   
5.     Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
   
6.     Private Declare Function PtInRegion Lib "gdi32" (ByVal hRgn As Long, ByVal X As Long, ByVal Y As Long) As Long
   
7.     Private Declare Function CreatePolygonRgn Lib "gdi32" (lpPoint As POINTAPI, ByVal nCount As Long, ByVal nPolyFillMode As Long) As Long
   
8. Function aa(R As Range, X As Range, Y As Range)
   
9.     Dim P(3) As POINTAPI
   
10.     P(0).X = R.Range("A1") * 100: P(0).Y = R.Range("B1") * 100
    
11.     P(1).X = R.Range("A2") * 100: P(1).Y = R.Range("B2") * 100
    
12.     P(2).X = R.Range("A3") * 100: P(2).Y = R.Range("B3") * 100
    
13.     P(3).X = R.Range("A4") * 100: P(3).Y = R.Range("B4") * 100
    
14.     Dim Rgn As Long
    
15.     Rgn = CreatePolygonRgn(P(0), 4, 1)
    
16.    
    
17.     If Rgn <> 0 Then
    
18.         If PtInRegion(Rgn, X * 100, Y * 100) > 0 Then
    
19.             aa = 1
    
20.         Else
    
21.             aa = 0
    
22.         End If
    
23.         DeleteObject Rgn
    
24.     Else
    
25.         aa = "#ERROR"
    
26.     End If
    
27. End Function
    

复制代码

microyip

crazy0qwer 发表于 2016-10-20 08:04
点在线上也算在四边形内。坐标最多两位小数。

你这是算什么呀，没看懂，请指教

wtueprgw

microyip 发表于 2016-10-19 23:53

多谢大神，这段代码完美解决了我的问题，哈哈哈

wtueprgw

crazy0qwer 发表于 2016-10-20 08:04
点在线上也算在四边形内。坐标最多两位小数。

感谢，不过，VBA提示我这个事64位的，运行出错，不知道怎么改，还行要感谢你的帮助，谢谢！！！