Mfc vers texte

[JJ1]

Re bonjour à tous,

Suite au poste de J Clerc (combinaisons 5/49) et les diverses réponses VBA apportées en format texte" ;" (pour ma part, je préfère la solution de KenDev d'avoir un nombre par cellule), il serait peut être utile de prévoir une sorte de procédure MFC texte avec des numéros saisis (en nombre) pour faire des recherches.
Je n'ai pas trouvé sur le Forum.
Je joins un petit exemple (plage F G à colorier)

A+

 

[JJ1]

Re : Mfc vers texte

Bonjour,
Je remonte ce sujet qui peut intéresser les personnes qui affichent les combinaisons avec des numéros séparés par des ; et qui veulent y faire des recherches.
Si vous avez une idée de procédure.
Bon dimanche

 

[job75]

Re : Mfc vers texte

Bonjour JJ1,

Pour colorer la cellule, cette MFC sur F1:G11 :

=SOMMEPROD((F1<>"")*ESTNUM(TROUVE(";"&$H$1:$L$1&";";";"&F1&";")))=NB($H$1:$L$1)

Il y a coloration si tous les numéros saisis en H1:L1 sont dans la cellule.

Pour colorer les nombres eux-mêmes (police), il faudra bien sûr une macro.

Fichier joint.

A+

 

[job75]

Re : Mfc vers texte

Re,

Pour le cas où H1:L1 est vide il vaut mieux utiliser cette formule pour la MFC :

=SOMMEPROD((F1<>"")*ESTNUM(TROUVE(";"&$H$1:$L$1&";";";"&F1&";")))/NB($H$1:$L$1)>=1

Pour colorer les nombres eux-mêmes voici une macro :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim saisie As Range, cel As Range, t$, l%, i%, j%
Set saisie = [H1:L1] 'plage à adapter
If Intersect(Target, saisie) Is Nothing Then Exit Sub
For Each cel In [F1:G11] 'plage à adapter
  cel.Font.ColorIndex = xlAutomatic 'RAZ
  t = cel.Text
  l = Len(cel)
  For i = 1 To l
    If IsNumeric(Mid(t, i, 1)) Then
      For j = i To l
        If Not IsNumeric(Mid(t, j, 1)) Then Exit For
      Next
      If Application.CountIf(saisie, Mid(t, i, j - i)) Then _
        cel.Characters(i, j - i).Font.Color = [N1].Interior.Color 'rouge
      i = j
    End If
  Next
Next
End Sub

Fichier (2).

Noter qu'il ne faut aucune formule dans la plage F1:G11...

Edit : remplacé =1 par >=1 dans la formule de la MFC.

A+

 

[job75]

Re : Mfc vers texte

Re,

Avec cette macro le fond des cellules est aussi coloré, plus besoin de MFC :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim saisie As Range, r As Range, Nsaisie As Byte, t$, l%, i%, j%, n%
Set saisie = [H1:L1] 'plage à adapter
If Intersect(Target, saisie) Is Nothing Then Exit Sub
Set r = [F1:G11] 'plage à adapter
Nsaisie = Application.Count(saisie)
Application.ScreenUpdating = False
r.Interior.Color = [M1].Interior.Color 'RAZ couleur fond
r.Font.ColorIndex = xlAutomatic 'RAZ couleur police
For Each r In r
  n = 0
  t = r.Text
  l = Len(r)
  For i = 1 To l
    If IsNumeric(Mid(t, i, 1)) Then
      For j = i To l
        If Not IsNumeric(Mid(t, j, 1)) Then Exit For
      Next
      If Application.CountIf(saisie, Mid(t, i, j - i)) Then
        r.Characters(i, j - i).Font.Color = [O1].Interior.Color 'rouge
        n = n + 1
      End If
      i = j
    End If
  Next
  If n And n >= Nsaisie Then r.Interior.Color = [N1].Interior.Color 'jaune
Next
End Sub

Fichier (3).

A+

 

[JJ1]

Re : Mfc vers texte

Bonjour Job,
Je viens de tester ton dernier code: Excellent.
Je pense qu'il va aider tous ceux qui travaillent les combinaisons (ou autre) en format texte, je n'avais pas trouvé sur le Forum une telle procédure et si complète (cellule + nombre).
Merci à toi.

Bonne soirée

ps: ta première formule avec somme prod/trouve est bien pensée.

 

[job75]

Re : Mfc vers texte

Re,

Le fichier (3) du post #5 ne va pas s'il y a des doublons de nombres.

Par ailleurs il était souhaitable que les modifications sur F1:G11 fussent immédiatement traitées.

Voir donc le fichier (4) avec cette macro plus complète (j'ai galéré) :

Private Sub Worksheet_Change(ByVal Target As Range)
Dim saisie As Range, r As Range, tablo(), t$, l%, i%, j%, n
Set saisie = [H1:L1] 'plage à adapter
Set r = [F1:G11] 'plage à adapter
If Intersect(Target, Union(r, saisie)) Is Nothing Then Exit Sub
Application.ScreenUpdating = False
r.Interior.Color = [M1].Interior.Color 'RAZ couleur fond
r.Font.ColorIndex = xlAutomatic 'RAZ couleur police
If Application.Count(saisie) = 0 Then Exit Sub
ReDim tablo(1 To saisie.Count)
For Each r In r
  If r <> "" Then
    For i = 1 To UBound(tablo)
      tablo(i) = saisie(i) 'initialisation
    Next
    t = r.Text
    l = Len(r)
    For i = 1 To l
      If IsNumeric(Mid(t, i, 1)) Then
        For j = i To l
          If Not IsNumeric(Mid(t, j, 1)) Then Exit For
        Next
        n = Application.Match(Val(Mid(t, i, j - i)), tablo, 0)
        If IsNumeric(n) Then
          r.Characters(i, j - i).Font.Color = [O1].Interior.Color 'police rouge
          tablo(n) = "" 'chaque valeur ne sert qu'une fois
        End If
        i = j
      End If
    Next
    If Application.Count(tablo) = 0 Then 'si toutes les valeurs ont été utilisées
      r.Interior.Color = [N1].Interior.Color 'fond jaune
    End If
  End If
Next
End Sub

Edit : j'avais oublié d'enlever la formule de la cellule F3...

A+

 

[JJ1]

Re : Mfc vers texte

Bonjour Job,

Le code précédent fonctionnait très bien à mon sens. Je ne pense pas que les combinaisons ordinaires comportent des doublons.

Merci pour ton travail avec ce nouveau code. Je comprends que ce n'était pas simple.

Bonne journée.

 

[job75]

Re : Mfc vers texte

Bonjour JJ1,

Le code précédent fonctionnait très bien à mon sens. Je ne pense pas que les combinaisons ordinaires comportent des doublons.

Oui, en fait je voulais voir ce que ça donnait avec des doublons...

A+