Calcul qui ne se fait pas bien

Le 01/02/2026 à 18:10

Bonjour

Dans le fichier joint j'ai un problème pour avoir un résultat correct

Additionner la valeur de lettres en horizontal et en vertical

Merci pour votre aide

20test1.xlsm (22.33 Ko)
Le 01/02/2026 à 18:40

Bonsoir Joco7915

En faisant de la sorte, ça fonctionne à voir avec plus poussé 

Sub CalculerTotalLettres()
  Dim Ws As Worksheet
  Dim Total As Integer
  Dim Valeur As Integer
  Dim Col As Long, Lig As Long
  Dim FlgBis As Boolean
  ' Définir la feuille de travail
  Set Ws = ThisWorkbook.Sheets("Feuil1")
  ' Initialiser le total
  Total = 0: FlgBis = False
  ' Boucle à travers chaque cellule de la plage
  For Lig = 1 To 10
    For Col = 1 To 9
CompterBis:
      If Ws.Cells(Lig, Col).Value <> "" Then
        Select Case UCase(Ws.Cells(Lig, Col).Value)
        Case "A", "E", "U"
          Valeur = 1
        Case "S"
          Valeur = 2
        Case "G"
          Valeur = 5
        Case "X"
          Valeur = 10
        Case Else
          Valeur = 0
        End Select
        ' Ajouter la valeur à total
        Total = Total + Valeur
      End If
      ' Vérifier si croisement des mots
      If Col > 1 Then
        ' Si pas déjà passé par là
        If FlgBis = False Then
          ' Si la céllule précédent et la cellule du dessous ne sont pas vides
          If Ws.Cells(Lig, Col - 1) <> "" And Ws.Cells(Lig + 1, Col) <> "" Then
            FlgBis = True: GoTo CompterBis
          End If
        End If
      End If
    Next Col
  Next Lig
  ' Afficher le résultat dans la cellule H1
  Ws.Range("M1").Value = Total
End Sub

Bonne soirée

Le 01/02/2026 à 19:00

Bonsoir,

Option Explicit

Sub CalculerTotalLettres()

Dim I As Integer, J As Integer, Total As Integer
Dim Plage As Range, cellule As Range
Dim Ws As Worksheet

    Set Ws = ThisWorkbook.Sheets("Feuil1")
    Set Plage = Ws.Range("A1:I10")
    Total = 0

    With Plage
         For I = 1 To .Columns.Count
             For J = 1 To .Rows.Count
                  If Not IsEmpty(.Cells(J, I)) Then
                     If WorksheetFunction.CountA(.Rows(J)) > 1 And WorksheetFunction.CountA(.Columns(I)) > 1 Then
                         Select Case UCase(.Cells(J, I))
                            Case "A", "E", "U"
                                  Total = Total + 2
                            Case "S"
                                  Total = Total + 4
                            Case "G"
                                  Total = Total + 10
                            Case "X"
                                  Total = Total + 20
                         End Select
                     Else
                          Select Case UCase(.Cells(J, I))
                            Case "A", "E", "U"
                                 Total = Total + 1
                            Case "S"
                                 Total = Total + 2
                            Case "G"
                                 Total = Total + 5
                            Case "X"
                                 Total = Total + 10
                         End Select
                     End If
                End If
             Next J

           Next I
    End With
    Ws.Range("M1").Value = Total

    Set Ws = Nothing: Set Plage = Nothing

End Sub
Le 01/02/2026 à 20:36

Bonsoir

Merci pour votre aide

je remet le fichier avec explications car le résultat n'est pas bon

8test1.xlsm (23.94 Ko)
Le 02/02/2026 à 02:42

Essayez mon code...

Le 02/02/2026 à 09:51

Bonjour à tous,

Problème sympa, une petite approche via formules matricielles (XL 365) pour le fun (je sais qu'il faut du VBA mais chez moi la proposition de Eric fonctionne bien donc je n'ajoute rien).

=LET(
    _grid; A1:I10;
    _tbScores; P2:Q7;
    _maskLett; NBCAR(SUPPRESPACE(_grid & "")) > 0;
    _stLett; MAJUSCULE(GAUCHE(_grid & ""; 1));
    _scKeys; INDEX(_tbScores; ; 1);
    _scVals; INDEX(_tbScores; ; 2);
    _matVals; SIERREUR(RECHERCHEX(_stLett; _scKeys; _scVals; 0); 0);
    SHIFTLEFT; LAMBDA(_m; ASSEMB.H(EXCLURE(_m; ; 1); SEQUENCE(LIGNES(_m); ; 0; 0)));
    SHIFTRIGHT; LAMBDA(_m; ASSEMB.H(SEQUENCE(LIGNES(_m); ; 0; 0); EXCLURE(_m; ; -1)));
    SHIFTUP; LAMBDA(_m; ASSEMB.V(EXCLURE(_m; 1); SEQUENCE(; COLONNES(_m); 0; 0)));
    SHIFTDOWN; LAMBDA(_m; ASSEMB.V(SEQUENCE(; COLONNES(_m); 0; 0); EXCLURE(_m; -1)));
    MASKHORIZ; LAMBDA(_m; 1 * _m * ((SHIFTGAUCHE(_m) + SHIFTDROITE(_m))) >= 1);
    MASKVERTI; LAMBDA(_m; 1 * _m * ((SHIFTUP(_m) + SHIFTDOWN(_m))) >= 1);
    _mh; MASKHORIZ(_maskLett);
    _mv; MASKVERTI(_maskLett);
    SOMME(_matVals * (_mh + _mv))
)
Le 02/02/2026 à 10:20

Bonjour tout le monde

@ Eric j'ai appliqué ton code ,mais le résultat est faux voir le fichier

Merci pour ton aide

6test1.xlsm (24.99 Ko)
Le 02/02/2026 à 10:46

@Joco si tu es ok avec les formules, la suivante est compatible XL 2021 :

=LET(
    _grid; A1:I10;
    _tbScores; P2:Q7;
    _maskLett; NBCAR(SUPPRESPACE(_grid & "")) > 0;
    _stLett; MAJUSCULE(GAUCHE(_grid & ""; 1));
    _scKeys; INDEX(_tbScores; ; 1);
    _scVals; INDEX(_tbScores; ; 2);
    _matVals; SIERREUR(RECHERCHEX(_stLett; _scKeys; _scVals; 0); 0);
    _r; SEQUENCE(LIGNES(_grid));
    _c; SEQUENCE(; COLONNES(_grid));
    _sl; SI(_c < MAX(_c); INDEX(_maskLett; _r; _c + 1); 0);
    _sr; SI(_c > 1; INDEX(_maskLett; _r; _c - 1); 0);
    _su; SI(_r < MAX(_r); INDEX(_maskLett; _r + 1; _c); 0);
    _sd; SI(_r > 1; INDEX(_maskLett; _r - 1; _c); 0);
    _mh; 1 * _maskLett * ((_sl + _sr) >= 1);
    _mv; 1 * _maskLett * ((_su + _sd) >= 1);
    SOMME(_matVals * (_mh + _mv))
)

L'avantage c'est que c'est instantané.

Le 02/02/2026 à 10:56

Ok, j'ai compris.

Il faut doubler seulement si deux cellules sont contigües horizontalement et verticalement.

Le 02/02/2026 à 11:52

Bonjour

@ saboh Merci pour ton aide

j'ai testé ta formule nickel ça fonctionne ,je vais voir pour la suite

@ Eric c'est bien doubler la valeur quand une lettre est utilisée 2 fois

Le 02/02/2026 à 12:02

Bonjour

Comme @saboh12617, une autre approche par formule matricielle.

l'idée est de tester toutes les cellules contigües. avec l'ajout d'une ligne/colonne de 0 à gauche/droite/dessus/dessous
test s'il y a un texte à droite ou gauche puis dessus ou dessous et multiplication par la valeur de la lettre

=LET(
_plage;$A$1:$I$10;
_gauche;ASSEMB.H(SEQUENCE(LIGNES(_plage);;0;0);N(ESTTEXTE(EXCLURE(_plage;;-1))));
_droite;ASSEMB.H(N(ESTTEXTE(EXCLURE(_plage;;1)));SEQUENCE(LIGNES(_plage);;0;0));
_dessus;ASSEMB.V(SEQUENCE(;COLONNES(_plage);0;0);N(ESTTEXTE(EXCLURE(_plage;-1))));
_dessous;ASSEMB.V(N(ESTTEXTE(EXCLURE(_plage;1)));SEQUENCE(;COLONNES(_plage);0;0));
_valeur;RECHERCHEX(_plage;$P$2:$P$7;$Q$2:$Q$7;0);
SOMME((MAP(_droite;_gauche;OU)+MAP(_dessus;_dessous;OU))*_valeur))

Stéphane

Le 02/02/2026 à 13:30

Re bonjour à tous

Je reviens avec un nouveau problème que je n'arrive pas à résoudre les explications sont dans le fichier

Merci pour votre aide

8test1.xlsm (21.25 Ko)
Le 02/02/2026 à 13:50

Re,

Si les cellules colorées sont fixes et invariables, on pourrait s'en sortir via formules si tu conçois une seconde grille avec par exemple 1 pour les cellules de coefficient 1, et 2 pour celles doublant (et 3 s'il y avait des triples etc.).

Cela marcherait pour F3 et J11 qui ne contiennent qu'un mot.

Cependant dans ton exemple tu as aussi H8 et tu dis "H8 doit doubler le premier mot qui a été posé mais pas le deuxième". D'accord, mais en regardant la grille maintenant on n'a aucune idée de l'ordre de placement des mots. C'est donc impossible, en l'état, de gérer ce cas. Que ce soit via VBA ou formules.

Si tu remplis la grille au fur et à mesure, alors tu devrais pouvoir t'en sortir, mais via VBA uniquement car les formules n'ont pas de "mémoire" => elles réévaluent sur l'état actuel du classeur.

Bref, il faut élucier comment tu remplis ta grille, et à partir de là, en récupérant un WorksheetChange sur les cellules colorées on pourrait stocker dans une variable/une cellule l'info que le multiplicateur ne s'applique que sur le mot et continuer. Mais ça devient un projet complexe et je pense qu'il serait utile de tout partager (difficile de faire une solution "plug & play" sur cette dernière question).

Le 02/02/2026 à 13:57

Le premier mot a être posé doit toujours passer par la cellule H8 en vertical ou en horizontal

ensuite je viens greffer d'autres mots mais qui obligatoirement sont accrochés a un mot déjà posé

les cellules colorées sont fixes

Le 02/02/2026 à 14:02

Oui j'ai compris comment tu remplis ta grille "en théorie". Mais quand on la regarde maintenant, comment on fait pour savoir si on doit faire x2 sur le mot vertical ou bien horizontal ? On ne peut pas.

D'où ma question sur le remplissage, en pratique, de ta grille.

Le 03/02/2026 à 16:37

Bonjour

En réfléchissant bien on considère que le premier mot sera en horizontal.

Si tu as une idée je suis preneur

Cordialement

Le 03/02/2026 à 17:32

D'accord, ci-joint une proposition via la formule légèrement revue pour prendre en compte une matrice de coefficients. C'est toujours le mot horizontal qui prend le score bonus.

6test1.xlsm (22.55 Ko)
=LET(
    _grid; A1:O15;
    _tbScores; AA2:AB27;
    _matCoefs; A30:O44;
    _maskLett; NBCAR(SUPPRESPACE(_grid & "")) > 0;
    _stLett; MAJUSCULE(GAUCHE(_grid & ""; 1));
    _scKeys; INDEX(_tbScores; ; 1);
    _scVals; INDEX(_tbScores; ; 2);
    _matVals; SIERREUR(RECHERCHEX(_stLett; _scKeys; _scVals; 0); 0);
    _r; SEQUENCE(LIGNES(_grid));
    _c; SEQUENCE(; COLONNES(_grid));
    _sl; SI(_c < MAX(_c); INDEX(_maskLett; _r; _c + 1); 0);
    _sr; SI(_c > 1; INDEX(_maskLett; _r; _c - 1); 0);
    _su; SI(_r < MAX(_r); INDEX(_maskLett; _r + 1; _c); 0);
    _sd; SI(_r > 1; INDEX(_maskLett; _r - 1; _c); 0);
    _mh; 1 * _maskLett * ((_sl + _sr) >= 1);
    _mv; 1 * _maskLett * ((_su + _sd) >= 1);
    _bonusH; (_mh = 1);
    _bonusV; (_mv = 1) * NON(_mh);
    _coefsUsed; 1 + (_matCoefs - 1) * (_bonusH + _bonusV);
    _matScore; _matVals * (_mh + _mv) * _coefsUsed;
    SOMME(_matScore)
)
Rechercher des sujets similaires à "calcul qui fait pas bien"