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

香川群子

我觉得可以很简单的用直线斜率、截距方法判断：
1. 分别求出任意四边形的4条直线的斜率k1/k2/k3/k4和截距b1/b2/b3/b4
2. 任意点x代入4条直线的斜率k1/k2/k3/k4 求出通过该点的截距t1/t2/t3/t4
    分别和b1/b2/b3/b4比较其大小关系即可。

假设上下边为L1、L3，左右边为L4、L2，那么应该是：
t1<=b1、t3>=b3 以及 t4<=b4、t2>=b2 就在四边形内部。

香川群子

请见附件。

限制条件为，图形是凸四边形，且顺序如图。

hhjjpp

搞定任意凸四边形：

qiuheyou

香川群子 发表于 2017-1-5 19:37
请见附件。

限制条件为，图形是凸四边形，且顺序如图。

麻烦大师帮我看下vba怎么用countif     http://club.excelhome.net/thread-1322511-1-1.html

香川群子

hhjjpp 发表于 2017-1-6 17:09
搞定任意凸四边形：

显然我的方法更简单。也很容易理解。

hhjjpp

香川群子 发表于 2017-1-7 14:43
显然我的方法更简单。也很容易理解。

但前提是需要区分边长之方位（把四点顺时针或逆时针旋转一下就不对了），如果遇到一组轮回顺序确定、但方位不定的凸四的点，就需要借助于视觉了。
在另一个近似平行四边形的贴我也想到了截距对比（而且当时是失败的），只不过没像你这样去求4个截距！

香川群子

hhjjpp 发表于 2017-1-7 15:22
但前提是需要区分边长之方位（把四点顺时针或逆时针旋转一下就不对了），如果遇到一组轮回顺序确定、但方 ...

如果确保图形是凸四边形，那么4个点的坐标无论如何改变顺序，
我都可以用VBA进行判断，得到正确的顺序，然后再进行计算。
(这一点函数没有VBA方便，因为VBA可以进行内部排序和各种变量交换。)

另外，如果图形是三角形，也可以很方便的用3个截距来进行是否内部的判断。
推广下去，只要把任意多边形正确划分为有限的三角形，就可以进行准确判断了。
哪怕是凹多边形也可以！

hhjjpp

香川群子

首先，对三角形的直线斜率类型分析，发现有24种不同的种类。
不同的种类对应的截距判断各自不同。

所以，写了个代码用来自动对三角形坐标进行顺序分析和类型判断。
然后就可以很轻松地进行截距判断了。

…………
进而引申到任意多边形，不管图形是凹凸都可以划分为多个三角形(但是这里需要人工分析)
然后就可以按三角形进行判断了。最后综合一下即可得到结果：

香川群子

1. Function f(p, p0, p1, p2, Optional k = 0)
   
2.     Dim a(2), b(1, 2), bk(2, 1), i&, j&, n&, s$, sf$, st$, t, tb, tf$, tp$, flg As Boolean
   
3.     st = ",0++,0X+,0-+,0-X,0--,+++,+X+,+-+,+-X,+--,+0+,+0X,+0-,+++,++X,++-,X--,X0-,X+-,---,-0-,-+-,-X-,---"
   
4.     sf = ",110,100,100,101,101,110,100,100,101,101,100,101,101,100,101,101,001,001,001,001,001,001,011,011"
   
5.    
   
6.     bk(0, 0) = f_Line(p0(1), p0(2), p1(1), p1(2), 0) '0-1
   
7.     bk(0, 1) = f_Line(p0(1), p0(2), p1(1), p1(2), 1)
   
8.    
   
9.    
   
10.     bk(1, 0) = f_Line(p1(1), p1(2), p2(1), p2(2), 0) '1-2
    
11.     bk(1, 1) = f_Line(p1(1), p1(2), p2(1), p2(2), 1)
    
12.    
    
13.     bk(2, 0) = f_Line(p2(1), p2(2), p0(1), p0(2), 0) '2-0
    
14.     bk(2, 1) = f_Line(p2(1), p2(2), p0(1), p0(2), 1)
    
15.    
    
16.     If p0(2) < p1(2) Then 'y0<y1
    
17.         If p0(2) < p2(2) Then 'y0<y2
    
18.             If Chk_k(bk(0, 1), bk(2, 1)) Then '0
    
19.                 a(0) = 0: a(1) = 1: a(2) = 2 '0-1-2-0
    
20.             Else
    
21.                 a(0) = 2: a(1) = 1: a(2) = 0 '0-2-1-0
    
22.             End If
    
23.         Else 'y0>=y2
    
24.             If p0(2) = p2(2) Then 'y0=y2 0 or 2
    
25.                 If p0(1) < p2(1) Then  'x0<x2
    
26.                     a(0) = 2: a(1) = 1: a(2) = 0 '0-2-1-0
    
27.                 Else 'x2<x0
    
28.                     a(0) = 2: a(1) = 0: a(2) = 1 '2-0-1-2
    
29.                 End If
    
30.             Else 'y2<y0
    
31.                 If Chk_k(bk(1, 1), bk(2, 1)) Then '2
    
32.                     a(0) = 1: a(1) = 0: a(2) = 2 '2-1-0-2
    
33.                 Else
    
34.                     a(0) = 2: a(1) = 0: a(2) = 1 '2-0-1-2
    
35.                 End If
    
36.             End If
    
37.         End If
    
38.     ElseIf p0(2) = p1(2) Then 'y0=y1
    
39.         If p0(2) < p2(2) Then 'y0=y1<y2 0 or 1
    
40.             If p0(1) < p1(1) Then  'x0<x1
    
41.                 a(0) = 0: a(1) = 1: a(2) = 2 '0-1-2-0
    
42.             Else 'x1<x0
    
43.                 a(0) = 0: a(1) = 2: a(2) = 1 '1-0-2-1
    
44.             End If
    
45.         Else 'y2<y0=y1
    
46.             If Chk_k(bk(1, 1), bk(2, 1)) Then '2
    
47.                 a(0) = 1: a(1) = 0: a(2) = 2 '2-1-0-2
    
48.             Else
    
49.                 a(0) = 2: a(1) = 0: a(2) = 1 '2-0-1-2
    
50.             End If
    
51.         End If
    
52.     Else 'y1<y0
    
53.         If p1(2) < p2(2) Then 'y1<y2
    
54.             If Chk_k(bk(0, 1), bk(1, 1)) Then '1
    
55.                 a(0) = 0: a(1) = 2: a(2) = 1 '1-0-2-1
    
56.             Else
    
57.                 a(0) = 1: a(1) = 2: a(2) = 0 '1-2-0-1
    
58.             End If
    
59.         Else 'y1>=y2
    
60.             If p1(2) = p2(2) Then 'y1=y2 1 or 2
    
61.                 If p1(1) < p2(1) Then 'x1<x2
    
62.                     a(0) = 1: a(1) = 2: a(2) = 0 '1-2-0-1
    
63.                 Else 'x2<x1
    
64.                     a(0) = 1: a(1) = 0: a(2) = 2 '2-1-0-2
    
65.                 End If
    
66.             Else 'y2<y1
    
67.                 If Chk_k(bk(1, 1), bk(2, 1)) Then '2
    
68.                     a(0) = 1: a(1) = 0: a(2) = 2 '2-1-0-2
    
69.                 Else
    
70.                     a(0) = 2: a(1) = 0: a(2) = 1 '2-0-1-2
    
71.                 End If
    
72.             End If
    
73.         End If
    
74.     End If
    
75.    
    
76.     For j = 0 To 2
    
77.         b(0, j) = j: b(1, j) = bk(a(j), 1): tp = tp & Get_k(b(1, j))
    
78.     Next
    
79.     If tp = "+++" Or tp = "---" Then
    
80.         For i = 2 To 1 Step -1
    
81.             For j = 0 To i - 1
    
82.                 If b(1, j) > b(1, j + 1) Then
    
83.                     t = b(0, j): b(0, j) = b(0, j + 1): b(0, j + 1) = t
    
84.                     t = b(1, j): b(1, j) = b(1, j + 1): b(1, j + 1) = t
    
85.                 End If
    
86.             Next
    
87.         Next
    
88. '        t = b(0, 0) & b(0, 1) & b(0, 2)
    
89.         If tp = "+++" Then
    
90.             If b(0, 0) = 1 Then tf = "100": n = 14 Else tf = "110": n = 6
    
91.         Else '"---"
    
92.             If b(0, 0) = 1 Then tf = "011": n = 24 Else tf = "001": n = 20
    
93.         End If
    
94.     Else
    
95.         n = (InStr(st, tp) + 3) / 4
    
96.         tf = Mid(sf, InStr(st, tp), 3)
    
97.     End If
    
98.     If k Then f = Join(a, "-") & ":" & n & " " & tp: Exit Function
    
99.    
    
100.     For i = 0 To 2
     
101.         If bk(a(i), 1) = "X" Then
     
102.             If Mid(tf, i + 1, 1) = 1 Then
     
103.                 If p(1) < bk(a(i), 0) Then Exit For
     
104.             Else
     
105.                 If p(1) > bk(a(i), 0) Then Exit For
     
106.             End If
     
107.         Else
     
108.             tb = p(2) - bk(a(i), 1) * p(1)
     
109.             If Mid(tf, i + 1, 1) = 1 Then
     
110.                 If tb < bk(a(i), 0) Then Exit For
     
111.             Else
     
112.                 If tb > bk(a(i), 0) Then Exit For
     
113.             End If
     
114.         End If
     
115.     Next
     
116.     If i = 3 Then f = 1
     
117. End Function
     
118. Function f_Line(x1, y1, x2, y2, m) 'm=0 b/=1 k
     
119.     If x1 = x2 Then
     
120.         If m Then f_Line = "X" Else f_Line = x1
     
121.     Else
     
122.         If m Then f_Line = (y1 - y2) / (x1 - x2) Else f_Line = (x1 * y2 - x2 * y1) / (x1 - x2)
     
123.     End If
     
124. End Function
     
125. Function Get_k(t) '按斜率结果返回直线类型 0X+-
     
126.     If t = "X" Then Get_k = t Else If t = 0 Then Get_k = t Else If t > 0 Then Get_k = "+" Else Get_k = "-"
     
127. End Function
     
128. Function Chk_k(k1, k2) As Boolean 'Check if k1,k2 逆时针
     
129.     If k1 = "X" Then
     
130.         If k2 < 0 Then Chk_k = True 'II
     
131.     ElseIf k2 = "X" Then
     
132.         If k1 >= 0 Then Chk_k = True 'I
     
133.     ElseIf (k1 < 0 And k2 >= 0) Or (k1 >= 0 And k2 < 0) Then
     
134.         If k1 > k2 Then Chk_k = True
     
135.     Else
     
136.         If k1 < k2 Then Chk_k = True
     
137.     End If
     
138. End Function
     

复制代码