[發問] 落點問題....(我目前從未到過的領域)

帖子: 10
主題: 2
精華: 0
積分: 62
點名: 2
作業系統: Win10
軟體版本: 2016
閱讀權限: 20
註冊時間: 2021-7-23
最後登錄: 2024-4-27

23^#

發表於 2022-10-16 16:03 | 只看該作者

回復 21# stillfish00

因為權限不足, 無法私訊. 但還是要特地來這裡感謝 stillfish00 大大. 用這段程式用經緯度跟 google map 的座標圖搭配之後, 就可以用VBA來判斷房屋的座落點, 十分好用. 謝謝.

帖子: 73
主題: 11
精華: 0
積分: 100
點名: 0
作業系統: Win 8
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-5-11
最後登錄: 2018-7-25

論壇榮譽勳章論壇贊助勳章

22^#

發表於 2013-11-14 22:43 | 只看該作者

回復 20# stillfish00
stillfish00大~ 試過，成功~ 給你拍拍手
非常完美的結果，好厲害，原本真的以為用VBA應該解不出來，結果"竟然被解出來了!"
超強的，真的非常謝謝你，祝你工作超順利 \(^0^)/

P.S.還有謝謝參與的ML089大，因為有你的參與，所以這個文章有了多人討論的感覺，不會顯得這麼孤單~謝謝你^^

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

21^#

發表於 2013-11-14 22:26 | 只看該作者

回復 19# ui123
A區面積 =PolyArea(C4:D8)
這只是ML089大在10樓要我另外幫忙寫的算面積的函數。

stillfish00

大學生 Rank: 4

帖子: 1018
主題: 15
精華: 0
積分: 1058
點名: 0
作業系統: win7 32bit
軟體版本: Office 2016 64-bit
閱讀權限: 50
性別: 男
來自: 桃園
註冊時間: 2012-5-9
最後登錄: 2022-9-28

20^#

發表於 2013-11-14 22:11 | 只看該作者

回復 19# ui123
修改如下，可含邊上的點，有優先順序(靠前的優先)
區域不限ABC三區可在參數自行增加，但要依參數順序。

Function pointInPoly(ptx As Double, pty As Double, arPoly) As Boolean
Dim i As Long, j As Long
Dim pix As Double, piy As Double
Dim pjx As Double, pjy As Double
For i = 1 To UBound(arPoly) - 1
j = i + 1
pix = arPoly(i, 1): piy = arPoly(i, 2)
pjx = arPoly(j, 1): pjy = arPoly(j, 2)
'多邊形邊上
If (pix - ptx) * (pjy - pty) - (piy - pty) * (pjx - ptx) = 0 And _
(pix - ptx) * (pjx - ptx) + (piy - pty) * (pjy - pty) <= 0 Then _
pointInPoly = True: Exit Function
'多邊形內部
If Not (piy > pty) = (pjy > pty) Then
If ptx < (pjx - pix) * (pty - piy) / (pjy - piy) + pix Then pointInPoly = Not pointInPoly
End If
Next
End Function
Function RegionABC(x As Double, y As Double, ParamArray polyRegion())
'3rd參數為A區，4th參數為B區。。。依此類推，越靠前的優先。
Dim i As Long, arPoly
For i = LBound(polyRegion) To UBound(polyRegion)
arPoly = polyRegion(i).Value
If UBound(arPoly, 2) <> 2 _
Or arPoly(1, 1) <> arPoly(UBound(arPoly), 1) _
Or arPoly(1, 2) <> arPoly(UBound(arPoly), 2) Then RegionABC = CVErr(xlErrRef): Exit Function
If pointInPoly(x, y, arPoly) Then
RegionABC = Chr(65 + i - LBound(polyRegion)) '依順位顯示A，B，C，D
Exit Function
End If
Next i
RegionABC = "不在範圍內"
End Function

複製代碼

帖子: 73
主題: 11
精華: 0
積分: 100
點名: 0
作業系統: Win 8
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-5-11
最後登錄: 2018-7-25

論壇榮譽勳章論壇贊助勳章

19^#

發表於 2013-11-14 21:07 | 只看該作者

回復 12# stillfish00

關於剛剛的問題 for stillfish00大及ML089大

1)包含點在ABC邊緣線上怎麼辦?(採取如果剛好在重疊的線上，取較小那一個(A<B<C)，例如，剛好在A區及B區交接線上，算A區的)
Ans:重疊線上，會判皆沒再ABC區上

2)這個可以用在多邊形嗎? 有些"不規則的多邊形"呢?
Ans:"應用性非常廣"，且可以對任何多邊形無限增加區域~超級厲害

3)還是不懂 A區面積 =PolyArea(C4:D8) 是要做什麼?
Ans:還是不懂這要做什麼 @@ 可以解說一下功能嗎? 感恩

stillfish00大，可以想出判重疊線嗎?
缺臨門一腳了!
如果重疊線可判出，就非常"完美了"，不然會漏判掉很多線上點~
剛剛使用心得，超實用再次謝謝 stillfish00大

帖子: 73
主題: 11
精華: 0
積分: 100
點名: 0
作業系統: Win 8
軟體版本: 2007
閱讀權限: 20
性別: 女
註冊時間: 2013-5-11
最後登錄: 2018-7-25

論壇榮譽勳章論壇贊助勳章

18^#

發表於 2013-11-14 20:37 | 只看該作者

回復 12# stillfish00
成功了，判定出ABC區了 ~Ya^^ 謝謝stillfish00大及ML089大

問一下stillfish00大及ML089大
1)包含點在ABC邊緣線上怎麼辦?(採取如果剛好在重疊的線上，取較小那一個(A<B<C)，例如，剛好在A區及B區交接線上，算A區的)
2)這個可以用在多邊形嗎? 有些"不規則的多邊形"呢?
3)還是不懂 A區面積 =PolyArea(C4:D8) 是要做什麼?
感謝萬分<(_ _)>