1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100
|
Sub Retrouve()
Dim Hauteur_Tableau As Integer
Dim Largeur_Tableau As Integer
Hauteur_Tableau = ActiveSheet.UsedRange.Rows.Count
Largeur_Tableau = ActiveSheet.UsedRange.Columns.Count
' Ecart maximum accepté entre chaque valeur
While epsilon = ""
If epsilon = "" Then epsilon = InputBox("Veuillez saisir la tolérance")
Wend
Dim i As Integer
Dim nombre_resultat As Integer
nombre_resultat = 0
Dim decalage As Integer
Dim ligne_debut As Integer
For i = 1 To Hauteur_Tableau
cellule_test = ActiveSheet.UsedRange.Cells(i, 1) 'on commence sur la cellule en haut a gauche
calcul (cellule_test)
Next i
End Sub
Function calcul(cellule)
'Si on est sur la premiere colonne on ecrit la valeur
If cellule.Column = 1 Then
decalage = Hauteur_Tableau + 1 + cellule.Row
Cells(decalage, 1).Value = cellule.Value
ligne_debut = cellule.Row
End If
'On vérifie quon est pas sur la derniere colonne
If cellule.Column < Largeur_Tableau Then
' On récupère les valeurs des données à côté
Valeur_observee = cellule.Value
Valeur_droite_face = Cells(cellule.Rows, cellule.Column + 1).Value
If i <> Hauteur_Tableau Then 'afin d éviter une erreur dernière ligne
Valeur_droite_bas = Cells(cellule.Rows + 1, cellule.Column + 1).Value
End If
If i <> 1 Then 'afin d éviter une erreur première ligne
Valeur_droite_haut = Cells(cellule.Rows - 1, cellule.Column + 1).Value
End If
If Abs(Valeur_droite_bas - Valeur_observee) < epsilon Then
Cells(decalage, cellule.Column).Value = cellule.Value
nouvelle_ligne = cellule.Rows + 1
nouvelle_colonne = cellule.Column + 1
cellule = Cells(nouvelle_ligne, nouvelle_clonne)
calcul (cellule)
Else
If Abs(Valeur_droite_face - Valeur_observee) < epsilon Then
Cells(decalage, cellule.Column).Value = cellule.Value
nouvelle_ligne = cellule.Rows
nouvelle_colonne = cellule.Column + 1
cellule = Cells(nouvelle_ligne, nouvelle_clonne)
calcul (cellule)
Else
If Abs(Valeur_droite_haut - Valeur_observee) < epsilon Then
Cells(decalage, cellule.Column).Value = cellule.Value
nouvelle_ligne = cellule.Rows - 1
nouvelle_colonne = cellule.Column + 1
cellule = Cells(nouvelle_ligne, nouvelle_clonne)
calcul (cellule)
Else 'si rien n est dans l intervalle
Range(Cells(decalage, 2), Cells(decalage, Largeur_Tableau)).Value = ""
End If
End If
End If
Else 'si on est sur la derniere colonne on incremente le compteur de reponse
nombre_resultat = nombre_resultat + 1
End If
MsgBox (nombre_resultat & "resultats ont été trouvés")
End Function |
Partager