مطلوب دالة للبحث عن قيمة تقريبية لاحداثيات مساحية

[Taher Shawki]

السلام عليكم ورحمة الله وبركاته

اخوتي في الله للتسهيل قمت بأرفاق ملف به صفحتين كل صفحة بها احداثيات لمجموعة نقاط تم رفعها 

المطلوب البحث النقطة التي تكون احداثياتها متقاربة في الصفحة الاولى

بمعنى اني اريد ان تظهر امام كل نقطة في الصفحة رقم 2 ما يقاربها في الصفحة رقم 1 

لان القيم ليست بنفسها و إنما تكون قريبة منهاZone-02-1copy.xlsxZone-02-1copy.xlsx

Zone-02-1copy.xlsx

[AbuuAhmed]

استفسار:

هل أحداثيات مساحية تعني أحداث مواقع جغرافية؟

وإذا كان الجواب بنعم هل هذه الأرقام عبارة عن درجات قوسية؟ أقصد درجة ودقيقة وثانية.

[AbuuAhmed]

جرب هذه المحاولة ربما فيها الحل
 

 

Zone-02-1copy_01.xlsm

تم تعديل أغسطس 22 بواسطه AbuuAhmed
تبديل المرفق لإضافة عمود التكرار

[Taher Shawki]

2 ساعات مضت, AbuuAhmed said:

استفسار:

هل أحداثيات مساحية تعني أحداث مواقع جغرافية؟

وإذا كان الجواب بنعم هل هذه الأرقام عبارة عن درجات قوسية؟ أقصد درجة ودقيقة وثانية.

نعم اخي احداثيات جغرافية 

لا ليست درجات انما هي احداثيات مترية

[AbuuAhmed]

تم التعديل على الكود للتسريع فقط.

Function getAvgPer(N1 As Double, E1 As Double, Z1 As Double, _
                   N2 As Double, E2 As Double, Z2 As Double) As Double
                       
    getAvgPer = (IIf(N1 < N2, N1 / N2, N2 / N1) + _
                 IIf(E1 < E2, E1 / E2, E2 / E1) + _
                 IIf(Z1 < Z2, Z1 / Z2, Z2 / Z1)) _
                 / 3
End Function

Function getClosestID(N1 As Double, E1 As Double, Z1 As Double) As Double
    Dim Sht As Worksheet
    Dim row As Long, lRow As Long
    Dim ClosestVal As Double, CurrVal As Double
    Dim ClosestID As Long
    
    Application.ScreenUpdating = False
    Set Sht = Sheets("1")
    
    With Sht
        lRow = .Range("A1").End(xlDown).row
        For row = 1 To lRow
            CurrVal = getAvgPer(N1, E1, Z1, .Cells(row, 2), .Cells(row, 3), .Cells(row, 4))
            If CurrVal > ClosestVal Then
                ClosestVal = CurrVal
                ClosestID = .Cells(row, 1)
                If ClosestVal = 1 Then Exit For
            End If
        Next row
    End With
    
    getClosestID = ClosestID
    
    Set Sht = Nothing
    Application.ScreenUpdating = True
End Function

 

[Taher Shawki]

لاكن ما ينفع بدون اكواد فيجوال 

لان اغلب استخدامي للاكسل على التلفون و بحتاج الملف ده كتير

لقد قمت بتجربة الكود على ملف كنت قد أنشأته سابقا ولاكن يدويا 

و لم يعطي نفس القيمة ولاكن اعطانى قيمة مختلفة و اعطانى احداثي بعيد عن الاحداثي نفسه 

للعلم النقاط المراد مقارنتها تم رفعها بجانب نقاط اخىي يعنى التفارب بينهم يكون في 10 او 15 سم على الاكثر 

لاكن الكود اعطانى احداثيات بعيدة جدا تصل الى 20 متر

[AbuuAhmed]

قدم لنا أي فكرة ممكن نحولها إلى أكواد
ربما لو يكون هناك توزيع نسب للأبعاد يكون البحث أقرب لمطلبك مثلا N تعطيه 50% والـ E 30% والـ Z يأخذ 20% وهكذا.
أنا قدمت اجتهادي وننتظر من الزملاء تقديم أفكار أخرى ويمكنك كذلك عرض السؤال على منتدى أكسس فلديهم الكثير ممن يجيد كتابة الأكواد كما خبراء الاكسل.

[AbuuAhmed]

إضافة فكرة أخر للتقييم

Zone-02-1copy_02.xlsm