mettre en couleur (FONT only) la valeur identique au sein d'une CELLULE

pasquetp

XLDnaute Occasionnel
bonjour,

je viens pour une question assez complexe

je bosse dans un entrepot et pour accelerer le rammasage, j'essaie d'optimiser les trajets

voici les allées:

appelons les "S101", "S102", "S103", "S104", "S105", "p101", "p102", "p103", "p104", "p105"

ca ce sont mes allées

chaque allées contient disons 10 rangées (de 1 a 10) et chaque "colonne" contient 5 "lignes" (a;b;c;d;e)

s101c4 ; s101d5 ; p102c10;......

voici la presentation dans mon fichier

REFERENCE suivi des adresses:

ref en colonne A et en colonne B on a les adresses separé par un point virgule : "X P102A18 [ 20 ] ; P102A6 [ 19 ] ; P102B12 [ 96 ] ; s105a3 [ 25 ] ; S105B7 [ 7 ]"

et ce que j'aimerai c'est que si je decide de m'attaquer a s101 que toutes les valeurs s101 et leur destination exacte (exe: s101c3) soit mis en bleu et le reste inchangés

ca donnerait cela (voir piece jointe)

ca a l'air compliqué mais d'un pont de vue pratique c'est l'évidence mais pas evident a realiser

Merci de votre aide
 

Pièces jointes

  • test.xlsm
    19 KB · Affichages: 32
  • test.xlsm
    19 KB · Affichages: 44
  • test.xlsm
    19 KB · Affichages: 46

pasquetp

XLDnaute Occasionnel
Re : mettre en couleur (FONT only) la valeur identique au sein d'une CELLULE

CA Y EST j'ai trouvé

Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)


Dim lDebut As Long, lFin As Long
Dim i As Integer, iNbCar As Integer
Dim c As Range

Application.ScreenUpdating = False
Columns("B:B").Select
With Selection.Font
.ColorIndex = xlAutomatic
.TintAndShade = 0
End With
Selection.Font.Bold = True
Selection.Font.Bold = False
Range("B1").Select


sMot = ListBox1.List(ListBox1.ListIndex)
iNbCar = Len(sMot)

For Each c In Range(Range("b65536").End(xlUp), Range("b1"))
sTexte = c.Value
For i = 1 To Len(sTexte) - iNbCar
lDebut = InStr(i, sTexte, sMot)
If lDebut > 0 Then
With c.Characters(Start:=lDebut, Length:=Len(sMot) + 6).Font
.ColorIndex = 3
.Bold = True
End With
End If
Next i
Next c

Application.ScreenUpdating = True

End Sub
 

Statistiques des forums

Discussions
312 198
Messages
2 086 144
Membres
103 129
dernier inscrit
Atruc81500