XL 2016 Recherche valeurs à partir de cinq critères

Benjamin69

XLDnaute Nouveau
Bonjour à tous,
Je planche sur un outil de calcul automatisé de remboursement de lunettes, pour une compagnie d'assurances.

Les critères à entrer pour permettre le fonctionnement sont les suivants :
  • Choix d'adulte ou enfant
  • Choix du contrat
  • Sphère
  • Cylindre
  • Addition
Ma macro convertit les 3 derniers critères en multiples de 100. Comme ça, elle peut aller chercher (théoriquement) un résultat dans une plage de données.

Sauf que je ne sais pas où j'ai merdouillé, car ma formule R1C1 me semble fausse... Mes données reviennent à 0 sans que je ne sache pourquoi...
Voici le code :

'Déclaration des variables
Dim Sphere As Long
Dim Cylindre As Long
Dim Addition As Long
Dim Spherecompar As Long
Dim Cylcompar As Long
'Conversion des dioptries en multiples de 100
'OEIL DROIT

Range("C45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("D45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("E45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("G45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("H45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("I45").Select
ActiveCell.FormulaR1C1 = "=R[-37]C*100"
Range("C45:I45").Select
Selection.Copy
A noter que sphère, cylindre et addition peuvent être exprimés en décimales... Je ne sais pas si le problème vient de là...
 

Benjamin69

XLDnaute Nouveau
Non, toujours la même erreur, incompatibilité de type code erreur 13... J'ai essayé de modifier le format de cellule, mais je ne vois pas d'où ça peut venir... Sinon j'ai effectivement modifié les plages de multiples, pour affiner au maximum, ce sera mieux, mais en attendant, la macro plante toujours au même endroit...

+++

J'ai essayé en déclarant les variables au début de la macro, entre autres
VB:
Dim xCyl As Byte
Dim xSph As Byte

Mais ça ne change rien, elle plante systématiquement au même endroit
 
Dernière édition:

eriiic

XLDnaute Barbatruc
Bonjour,

Je ne pense pas qu'une simple multiplication par 100 soit ici contre productif. Je reconnais que les formules via VBA sont peut être inutiles, mais là, franchement, c'est pinuts !!!!
Vu que je n'ai pas vu ces lignes de code dans le fichier j'ai précisé "si on peut l'inscrire directement sur la feuille"
On peut même rajouter un étage si tu veux : mettre un code qui construit le code vba qui inscrit la formule sur la feuille.
Ce n'est pas grave, c'est pour une simple multiplication par 100...

Mais tu as raison. Signaler d'éventuelles mauvaises pratiques doit sans doute sortir du cadre d'un forum d'aide. Ne perdons pas de temps avec cela.
eric

PS : désolé, je n'ai pas trouvé d'endroit adéquat pour mettre les 4 !!!! bien agressifs. Ca me démangeait pourtant
 

Benjamin69

XLDnaute Nouveau
J'ai essayé de modifier le format des cellules, de déclarer les variables correctement, mais rien n'y fait, je sèche...

Pour @eriiiic, voici le code en entier :
VB:
Sub Recherche2()

Dim xCyl As Byte
Dim xSph As Byte


    With Sheets("Accueil OCA2")
        '-------------------------------------
        '                  RECUPERATION DU NOM
        '-------------------------------------
        xEntrep = UCase(.[L3])
        '-------------------------------------
        '                 TEST QUALITE et TYPE
        '-------------------------------------
        xQT = Left(.[L4], 1) & Left(.[L5], 1)
        Select Case xQT
            Case Is = "AS"      'Adulte + Simple
                xLigDeb = 3
            Case Is = "AP"      'Adulte + Progressif
                xLigDeb = 10
            Case Is = "ES"      'Enfant + Simple
                xLigDeb = 17
            Case Is = "EP"      'Enfant + Progressif
                xLigDeb = 24
        End Select
       
        For xOeil = 1 To 2
            Select Case xOeil
                Case Is = 1 '--------------------- OEIL DROIT
                    xCyl = .[D3] * 100
                    xSph = .[C3] * 100
                Case Is = 2 '--------------------- OEIL GAUCHE
                    xCyl = .[D4] * 100
                    xSph = .[C4] * 100
            End Select
           
            '-------------------------------------
            '              TEST VALEUR CYLINDRE
            '-------------------------------------
            Select Case xCyl
                Case 0 To 199
                    xCol = "C"
                Case 200 To 399
                    xCol = "D"
                Case 400 To 999
                    xCol = "E"
            End Select
            '-------------------------------------
            '                TEST VALEUR SPHERE
            '-------------------------------------
            Select Case xSph
                Case 0 To 399
                    xLig = 0
                Case 400 To 599
                    xLig = 1
                Case 600 To 799
                    xLig = 2
                Case 800 To 999
                    xLig = 3
            End Select
            xResult = Sheets(xEntrep).Range(xCol & xLigDeb + xLig)
            Select Case xOeil
                Case Is = 1 '--------------------- OEIL DROIT
                    .[C9] = xResult
                Case Is = 2 '--------------------- OEIL GAUCHE
                    .[C10] = xResult
            End Select
        Next xOeil
    End With
End Sub

Si tu as une solution pour me sortir cette épine du pied, je suis preneur :)
 

eriiic

XLDnaute Barbatruc
As-tu essayé avec Replace comme dit précédemment ? :
VB:
xCyl = replace(.[D3].value,",",".") * 100
et Dim xCyl As Double
Je me demande pourquoi tu veux absolument travailler avec *100 et non avec le décimal mais bon...

Mais à mon avis tu as pris un mauvais départ.
Tu devrais avoir une VRAIE base de données unique (sur 1 feuille) avec les champs 'contrat', 'qualité', etc et les paramètres liés. Avec une colonne 'clé' qui concatène les champs clés pour retrouver la ligne facilement.
http://www.xlerateur.com/divers/2010/05/14/les-13-regles-d’or-pour-utiliser-excel-comme-gestionnaire-de-donnees-612/
Après rien de plus simple de calculer sans (sans doute) aucune macro.
eric
 

Benjamin69

XLDnaute Nouveau
@eriiiic ça ne fonctionne pas avec le code modifié.
Les multiples de 100, c'était pour tout simplement permettre une recherche X/Y plus simple, sans avoir à écrire toutes les possibilités de résultat sur une seule feuille de calcul.

Auquel cas, j'aurai utilisé une simple recherchev, mais là, les paramètres sont (à mon avis) trop nombreux pour utiliser cette formule
 

eriiic

XLDnaute Barbatruc
Avec le peu que j'ai vu de ton classeur, pour moi rien pour l'instant ne justifie l'utilisation de vba.

permettre une recherche X/Y plus simple, sans avoir à écrire toutes les possibilités de résultat sur une seule feuille de calcul.
Tu as Equiv() pour ça, avec en 3ème paramètre :
type Comportement
1 ou omis La fonction EQUIV recherche la valeur la plus élevée qui est inférieure ou égale à celle de l’argument valeur_cherchée. Les valeurs de l’argument matrice_recherche doivent être placées en ordre croissant, par exemple : ...-2, -1, 0, 1, 2, ..., A-Z, FAUX, VRAI.

Auquel cas, j'aurai utilisé une simple recherchev, mais là, les paramètres sont (à mon avis) trop nombreux pour utiliser cette formule
Fait une vraie bdd comme je te l'ai dit, avec une clé en A : =B2&"_"&C2&"_"& etc & etc & etc
et plus de problème non ?
Cijoint un exemple bidon mais que j'ai essayé de rendre proche de ton problème. Ah, mon excel a planté avant une sauvegarde, je te le refais un peu plus tard...
eric
 

Lolote83

XLDnaute Barbatruc
Re bonjour à tous,
Comme le dis Eriiiic, avec une bonne base de données et quelques formules bien alambiquées, il n'y a pas de problème.
Pour ma part, je me suis servi du fichier transmis ,et juste fais une petite macro (certes agrémentée d'un formulaire) mais je ne vois pas sur quelle ligne tu as un souci exactement.
Peux tu lorsque tu es en débogage (ligne bloquée et surlignée en jaune), nous faire une copie d'écran.
Sinon, si c'est le formulaire qui pose problème, inscrire directement tes valeurs Sphère et Cylindre dans les cellules correspondantes et exécuter la macro du module2 intitulé Recherche2.
Du coup, je joints le fichier raccourci pour voir
@+ Lolote83
 

Pièces jointes

  • Copie de BENJAMIN69 - TEST grille automatisée (BIS).xlsm
    57.1 KB · Affichages: 13

eriiic

XLDnaute Barbatruc
Re,

Bon, j'ai refait le fichier perdu...
Exemple avec une formule. Qu'on pourrait même simplifier vu qu'il y a un pas régulier de 2 en 2.
eric
 

Pièces jointes

  • Classeur1.xlsx
    11 KB · Affichages: 24
Dernière édition:

Discussions similaires

Réponses
1
Affichages
1 K

Statistiques des forums

Discussions
311 715
Messages
2 081 822
Membres
101 821
dernier inscrit
hybroxis