0 votes
in VBA by Beginner (17 points)
Sub trouver_plus_proche()

Dim ws_onglet As Worksheet
Dim lstrw_initial As Long, lstrw_par As Long
Dim valeur_initial As Variant, valeur_par As Variant
Dim ecart_temp As Variant, ecart_final As Variant
Dim valeur_retenu As Variant, titre_retenu As String

'identifier l'onglet
Set ws_onglet = Worksheets(4)
'trouver la derniere ligne valeurs initiales
lstrw_initial = ws_onglet.Cells(Rows.Count, 1).End(xlUp).Row
'trouver la derniere ligne parametres
lstrw_par = ws_onglet.Cells(Rows.Count, "F").End(xlUp).Row
'boucle sur les valeurs initiales
For i = 2 To lstrw_initial

   'par defaut
   ecart_final = ""
   'identifier valeur
    valeur_initial = ws_onglet.Cells(i, 1)
   'boucle sur les parametres
   For p = 2 To lstrw_par

      'identifier valeur par
      valeur_par = ws_onglet.Cells(p, "F")
      ' calculer ecart entre valeur initiale et valeur parametre
      ecart_temp = valeur_initial - valeur_par
      'mettre l'ecart en positif
      If ecart_temp < 0 Then
         ecart_temp = -ecart_temp
      End If
      'comparer avec l'ecart final, si plus petit alors retenir nouvelleinformation
      If ecart_final <> "" Then
         If ecart_temp < icart_final Then
            ecart_final = ecart_temp
            valeur_retenu = valeur_par
            titre_retenu = ws_onglet.Cells(p, "G")
         End If
      Else
            ecart_final = ecart_temp
            valeur_retenu = valeur_par
            titre_retenu = ws_onglet.Cells(p, "G")
     End If
   'fin boucle parametre
    Next
   'coller les information
    With ws_onglet
        .Cells(i, 2) = valeur_retenu
        .Cells(i, 3) = titre_retenu
    End With
'fin boucle
Next
'message de fin
MsgBox ("Done")

End Sub



Here is the code but it dosn't work properly I need to find the closest point to my gps data file.

1 Answer

0 votes
by Expert (911 points)

Try this:

Option Explicit

Sub find_nearest()

Dim ws_tab As Worksheet
Dim lstrw_initial As Long, lstrw_par As Long
Dim i As Long, p As Long
Dim value_initial As Variant, value_by As Variant
Dim difference_temp As Variant, difference_final As Variant
Dim retained_value As Variant, retained_title As String

'identify the tab
Set ws_tab = Worksheets(4)
'find the last row initial values
lstrw_initial = ws_tab.Cells(Rows.Count, 1).End(xlUp).Row
'find the last row parameters
lstrw_par = ws_tab.Cells(Rows.Count, "F").End(xlUp).Row
'loop on initial values
For i = 2 To lstrw_initial
'by default
difference_final = Empty
'identify value
value_initial = ws_tab.Cells(i, 1)
    'loop on parameters
    For p = 2 To lstrw_par
        'identify value by
        value_by = ws_tab.Cells(p, "F")
        'calculate the absolute difference between initial value and parameter value
        difference_temp = Abs(value_initial - value_by)
        'compare with final difference; if smaller retain new information
        If IsEmpty(difference_final) Then difference_final = 1.1 * difference_temp
        If difference_temp < difference_final Then
            difference_final = difference_temp
            retained_value = value_by
            retained_title = ws_tab.Cells(p, "G")
        End If
    'end loop parameter
    Next p
    'update the information
    With ws_tab
        .Cells(i, 2) = retained_value
        .Cells(i, 3) = retained_title
    End With
'end loop
Next i
'end message
MsgBox ("Done")

End Sub

If that doesn't work, please use the Table button to provde representative data from the worksheet and/or use the Image button to add a screenshot of representative rows from the worksheet. Those buttons are on either side of the "Insert Code Snippet" button.

When you post a question, please oblige us by responding to comments and answers. Also, you might be interested in My Excel Toolbox.

Welcome to wellsr Q&A
Ask any questions you have about VBA and Python and our community will help answer them. wellsr Q&A is the standalone question and answer platform for wellsr.com. If you have a question about one of our specific tutorials, please include a link back to the tutorial.

Getting Started
Register
VBA Cheat Sheets (On Sale Now)

Looking for something else? Hire our team directly through ourVBA Help page, instead.

For more programming tips visit the VBA Tutorials Blog and the Python Tutorials Blog.

...