Résultat de VLOOKUP s'écrit dans une colonne pas dans une plage

Bonjour JoBar,

ton fichier en retour : https://www.cjoint.com/c/MGDkC5eaJt0

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

à l'ouverture du fichier, tu es sur la feuille "Calculs" ; note bien que sous la ligne 50,
tout est vide : j'ai supprimé tes formules de la colonne B et ta formule de C71.

va sur la feuille "Résultat ancien" ; toute la partie grise est vide, et il n'y a aucune
formule : c'est car j'ai supprimé tes formules de la plage C8:C16.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

fais Ctrl r (ou clique sur le bouton "Clic pour résultat") ; lis toute la partie grise.

note qu'en ligne 3 et en ligne 7, ça ne se termine plus par des tirets sans chiffre :
"... 13 - 15 - 16 - 18 - 26" au lieu de "... 13 - 15 - 16 - 18 - 26 -  -  -" avant.

note que juste à droite des chiffres rouges, en colonne C, il y a des formules
(mais pas en dessous).

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

attention : dans tes formules précédentes de C8:C16, il manquait deux « $ » !

ta formule de C8 : =SIERREUR(RECHERCHEV(B8;Feuil1!X77:Y84;2;0);"")
ma formule C8 : =SIERREUR(RECHERCHEV(B8;Feuil1!X$77:Y$84;2;0);"")

ça fait que par exemple, ta formule de C12 est erronée :

ta formule de C12 : =SIERREUR(RECHERCHEV(B12;Feuil1!X81:Y88;2;0);"")
ma formule C12 : =SIERREUR(RECHERCHEV(B12;Feuil1!X$77:Y$84;2;0);"")

avec ton X81:Y88, la plage de la recherche n'est pas valable !  :(

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

retourne sur la feuille "Calculs" ; sous la ligne 50, lis toutes les données ;
note que même après exécution de la macro, il n'y a aucune formule,
ni en colonne B, ni en C71.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

va sur la feuille "Résultat" ; il y a le texte de B2 et B4, à gauche du bouton gris ;
tout le reste est vide ; fais Ctrl t (ou clique sur le bouton "Clic pour résultat").

lis toutes les données ; là aussi, il n'y a aucune formule.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

j'ai fait plein de modifications dans ton code VBA, alors lis bien attentivement
ces 2 modules : Module1 (macro Résultat) et Module2 (macro Tri).

si besoin, tu peux demander une adaptation ; à te lire pour avoir ton avis.  :)
(si toutefois tu repasses par ici, bien que ton sujet date du 11 juillet)

rhodo

@JoBar

Lis d'abord mon post précédent de 13:38.

code VBA de Module1 (60 lignes) :

Option Explicit

Sub Résultat()
  If ActiveSheet.Name <> "Résultat ancien" Then Exit Sub
  Application.ScreenUpdating = 0: Worksheets("Feuil1").Select 'aller sur "Feuil1"
  'collecte des données de "Feuil1" (colonnes A à AU, lignes 1 à 71)
  Dim sh As Worksheet, m&, r&, chf%, dlg&, col%, lg1%, lg2&, lg3&, n As Byte, i As Byte, k&
  Set sh = Worksheets("Calculs"): m = Rows.Count
  r = Cells(m, "X").End(3).Row: If r < 77 Then Exit Sub
  dlg = sh.Cells(m, "A").End(3).Row: lg2 = 51: lg3 = lg2
  If dlg > 50 Then sh.Range("A51:B" & dlg).ClearContents
  sh.[C51:C70].ClearContents 'remise à zéro de range C51:C70
  For col = 1 To 47 'colonnes n° 1 à 47 = colonnes A à AU
    For lg1 = 1 To 71
      With Cells(lg1, col)
        If Not IsEmpty(.Value) Then 'cellule non vide
          k = .Interior.Color 'k = couleur de remplissage
          If k = 65535 Or k = 49407 Then 'jaune ou orange
            n = 0 'on va vérifier qu'il y a ces 4 bordures :
            For i = 7 To 10 'gauche, haut, bas, droite
              If .Borders(i).LineStyle = 1 Then n = n + 1
            Next i
            If n = 4 Then 'cellule avec bordure "Contour"
              If IsNumeric(.Value) Then 'valeur numérique
                chf = .Value: sh.Cells(lg2, 1) = chf
                For i = 77 To r
                  If chf = Cells(i, 24) Then 'chf doit être un chiffre de la plage "X77:X##"
                    sh.Cells(lg2, 2) = chf: sh.Cells(lg3, 3) = chf: lg3 = lg3 + 1: Exit For
                  End If
                Next i
                lg2 = lg2 + 1
              End If
            End If
          End If
        End If
      End With
    Next lg1
  Next col
  sh.Select 'aller sur la feuille "Calculs"
  With [C51:C70]
    .RemoveDuplicates 1, 2 'enlever les doublons
    n = WorksheetFunction.CountIf([C51:C70], ">0"): [C71] = n
    [C51].Resize(n).Sort [C51], 1 'tri croissant
    .HorizontalAlignment = 3: .VerticalAlignment = 2
  End With
  Dim s$: Const p As String * 34 = "Phrase sans variable sur la ligne "
  With Worksheets("Résultat ancien")
    .[C1] = "Titre de la Fiche": .[A2:B18].ClearContents
    .[A2] = "Prendre " & n & " fiches qui correspondent au nombre de chiffres récapitulés"
    For i = 1 To n: k = [C50].Offset(i): s = s & k & " - ": .[B7].Offset(i) = k: Next i
    .Range("C8:C" & 7 + n).Formula = _
      "=IFERROR(VLOOKUP(B8,Feuil1!X$77:Y$" & r & ",2,0),"""")" 'formule RechercheV
    s = Left$(s, Len(s) - 3)
    .[A3] = "Chiffres numéros : " & s: .[A4] = "(Noter sur chaque fiche un numéro)"
    .[A5] = "Ranger ces fiches numérotées avec " & n & " qsdf qfdf hjj khllm....."
    .[A6] = p & "6": .[A7] = .[A3]: .[A17] = p & 17: .[A18] = p & 18
    .Select 'aller sur la feuille "Résultat ancien"
  End With
End Sub

rhodo

@JoBar

Lis d'abord mes 2 posts précédents de 13:38 et 20:55.

dans le fichier Excel, les commentaires du code VBA sont bien alignés ;
ici, ce n'est plus le cas (même si y'a le même nombre d'espaces).

code VBA de Module2 (57 lignes) :

Option Explicit

Sub Tri()
  On Error GoTo Fin
  If ActiveSheet.Name <> "Résultat" Then Exit Sub
  Application.ScreenUpdating = 0: Worksheets("Feuil1").Select
  Dim T, DL&, m&, r&, n&, k&, i&, j%, chf%, b As Byte, c As Byte
  T = [A1:AU71]: ReDim T2(1): m = Rows.Count
  r = Cells(m, "X").End(3).Row: If r < 77 Then Exit Sub              'r = dernière ligne en colonne X
  For i = 1 To UBound(T)
    For j = 1 To UBound(T, 2)
      If T(i, j) <> "" Then                                          'cell non vide
        If Cells(i, j).Interior.Color = RGB(255, 192, 0) Then        'avec fond orange
          c = 0                                                      'avec ces 4 bordures :
          For b = 7 To 10                                            'gauche, haut, bas, droite
            If Cells(i, j).Borders(b).LineStyle = 1 Then c = c + 1
          Next b
          If c = 4 Then                                              'cell avec bordure "Contour"
            If IsNumeric(T(i, j)) Then                               'et val numérique, alors...
              chf = T(i, j)
              For b = 77 To r                                        'chf doit être un chiffre de la plage "X77:X##"
                If chf = Cells(b, 24) Then                           'précaution, au cas où le orange n'est pas bon.
                  T2(n) = T(i, j)                                    'ranger la valeur
                  n = n + 1                                          'compte le nombre trouvé
                  ReDim Preserve T2(n)
                  Exit For
                End If
              Next b
            End If
          End If
        End If
      End If
    Next j
  Next i
  Worksheets("Résultat").Select
  [BZ1].Resize(UBound(T2), 1).Value = Application.Transpose(T2)      'ranger le résultat
  [BZ1].Resize(n).RemoveDuplicates 1, 2                              'supprimer les doublons
  k = Cells(m, "BZ").End(3).Row                                      'k = dernière ligne en colonne BZ
  [BZ1].Resize(k).Sort [BZ1], 1                                      'tri croissant
  T = [BZ1].Resize(k): [BZ1].Resize(k).ClearContents                 'récup & effacer BZ
  [C2] = n: [C4] = k                                                 'nb collectés / nb différents collectés
  n = Cells(m, "B").End(3).Row                                       'n = dernière ligne en colonne B
  If n > 7 Then [B8].Resize(n, 2).ClearContents                      'effacer valeurs précédentes
  With [B8].Resize(k)                                                'ranger valeurs collectées
    .HorizontalAlignment = 4: .IndentLevel = 1: .Value = T
  End With
  With Range("C8:C" & 7 + k)
    .Formula = _
      "=IFERROR(VLOOKUP(B8,Feuil1!X$77:Y$" & r & ",2,0),"""")"       'formule RechercheV
    .HorizontalAlignment = 2: .IndentLevel = 1
    .Value = .Value                                                  'coller valeurs
  End With
  Exit Sub
Fin:
  MsgBox "Une erreur a été rencontrée."
End Sub

rhodo

@JoBar

Lis d'abord mes 3 posts précédents de 13:38, 20:55, et 21:08.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

dans le fichier, Module1 est déjà ouvert puisqu'à droite on voit sa page de code ;
Module2 est fermé ; voici comment faire pour l'ouvrir :

côté gauche, et en haut, il y a la fenêtre "Projet" ; sous « ThisWorkbook », il y a
« Modules » ; dessous, clique sur « Module2 » et appuie sur la touche Entrée.

autre façon : faire un double-clic sur « Module2 ».

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

dans ton fichier initial, il y avait beaucoup de modules vides ouverts (ce qui ne
sert à rien) : modules des feuilles et module de ThisWorkbook ; il me semble
que tu ne sais pas comment fermer un module ; si oui, voici comment faire :

côté droit, clique sur la page de code du module à fermer (que cette page de
code soit vide ou non) ; puis appuie sur les deux touches Ctrl F4.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

tu peux demander une adaptation (ou des infos complémentaires) ;
n'oublie pas de me donner ton avis (si tu repasses sur ce sujet).

rhodo

Bonjour Vince,

au début, je n'avais pas compris comment faire l'exo de JoBar ;
c'est pourquoi j'y ai répondu avec un très gros retard.  :(

du coup, JoBar n'a pas vu ma réponse !  :(  peux-tu lui envoyer
un message à son adresse mail privée pour le prévenir que j'ai
fait son exo et qu'il a une réponse ? (si oui, merci d'avance)

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

d'autre part, le formulaire de contact ne marche pas ; peux-tu
le déboguer pour qu'on puisse te contacter en privé ?

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

note 1 : j'ai mis ici le texte de mon signalement car je ne suis
pas sûr que le signalement fonctionne ; peut-être qu'il est
bogué lui aussi ?

note 2 : Vince est l'Administrateur de ce site.

rhodo