Microsoft 365 vba convertir nombre au format texte pour calcul et mise en fome conditionnelle

[Piaf79]

Bonsoir à tous,
Je récupère dans un fichier Excel des données de l x h au format texte comme cf. colonne D de l'exemple joint.
Je souhaite diviser le chiffre de gauche par le chiffre de droite et mettre en rouge les cellules de la colonne D dont le résultat serait différent de 0,80
J'ai essayé via des formules comme STXT puis CNUM mais je n'arrive pas au résultat escompté...
Quelqu'un aurait il une idée ?
Piaf79

 

[Dranreb]

Bonsoir.
Vos textes commencent par un unicode 8234 (202A en hexadécimal) auquel aucun caractère n'est attribué.

 

[gbinforme]

Bonsoir,
une solution avec STXT

 

[Piaf79]

Bonsoir,
une solution avec STXT

Merci gbinforme.
Est-il possible de le transcrire en VBA ? pour l'appliquer à toutes les cellules non vides de la colonne D ?
Piaf79

 

[Piaf79]

Merci gbinforme.
Est-il possible de le transcrire en VBA ? pour l'appliquer à toutes les cellules non vides de la colonne D ?
Piaf79

Bjr le forum, quelqu'un peut il m'aider dans la transcription du code ? Ou m'aiguiller pour essayer d'y arriver avec mon maigre capital vba ?
Merci par avance.
Bonne journée à tous,
P79

 

[Staple1600]

Bonjour le fil

Test OL sur l'échantillon du fichier exemple
(Sélectionnez la plage D27 avant de lancer la macro)

Sub test_OK()
Dim c As Range, tmp$
For Each c In Selection
tmp = nettoyer(c.Text)
c.Offset(, 1) = Round((Split(tmp, "x")(0) * 1) / (Split(tmp, "x")(1) * 1), 3)
c.Offset(, 1).NumberFormat = "#,##0.00"
Select Case c.Offset(, 1).Value
Case Is <> 0.8
c.Offset(, 1).Font.Color = vbRed
End Select
Next
End Sub
Function nettoyer(txt As String)
Dim output$, c$, i&, iAsc%:     output = ""
For i = 1 To Len(txt)
c = Mid(txt, i, 1): iAsc = AscW(c)
    If iAsc <= 255 Then
    output = output & c
    End If
Next
nettoyer = output
End Function

 

[Piaf79]

Merci Staple cela fonctionne parfaitement !
Question, n'est il pas possible de faire la manip sans avoir besoin de sélectionner la plage au préalable avant d'exécuter la macro. Lui demander par exemple d'exécuter la code sur toute les cellules non vides de la colonne D à partir de D2 ?

 

[Staple1600]

Re

Si c'est possible
Tu ne vois pas comment faire?

 

[Staple1600]

Re

Comme c'est déjà fait, je poste
(évidemment, il faut garder la fonction nettoyer dans le projet VBA)

Sub test_OK_bis()
Dim c As Range, tmp$, f As Worksheet:       Set f = ActiveSheet
For Each c In Range(f.[D2], f.Cells(Rows.Count, "D").End(3))
tmp = nettoyer(c.Text)
c.Offset(, 1) = Round((Split(tmp, "x")(0) * 1) / (Split(tmp, "x")(1) * 1), 3)
c.Offset(, 1).NumberFormat = "#,##0.00"
Select Case c.Offset(, 1).Value
Case Is <> 0.8
c.Offset(, 1).Font.Color = vbRed
End Select
Next
End Sub

 

[Piaf79]

Un grand merci pour votre aide.
P79

 

[gbinforme]

Bonjour,

Tes données sont assez complexe mais voici une autre solution qui devrait répondre à ton souhait :

Sub verif_l_h()
Dim cel As Range, deb As String, fin As String, pos As Integer, dec As Integer
    With ActiveSheet
        For Each cel In .Range("D2:D" & ActiveSheet.Cells(Rows.Count, "D").End(xlUp).Row)
            pos = InStr(cel.Value, "x")
            If pos > 2 Then
                dec = IIf(IsNumeric(Left(cel.Value, 1)), 1, 2)
                deb = Mid(cel.Value, dec, pos - dec - 1)
                dec = IIf(IsNumeric(Right(cel.Value, 1)), 1, 2)
                fin = Mid(cel.Value, pos + 2, Len(cel.Value) - pos - dec)
                If Round(deb / fin, 2) <> 0.8 Then
                    cel.Font.Color = -16776961
                Else
                    cel.Font.ColorIndex = xlAutomatic
                End If
            End If
        Next cel
    End With
End Sub

 

[Staple1600]

Bonjour gbinforme

Comme c'est pondu dans mon VB, je poste
C'est juste un peu plus secure que ma précédente proposition.
Et la fonction NETTOYER est raccourcie d'un chouia.

Sub test_OK_ter()
Dim c As Range, tmp$, f As Worksheet:       Set f = ActiveSheet
Application.ScreenUpdating = False
For Each c In Range(f.[D2], f.Cells(Rows.Count, "D").End(3))
If Not c.HasFormula Then
tmp = NETTOYER_B(c.Text)
c.Offset(, 1) = Round((Split(tmp, "x")(0) * 1) / (Split(tmp, "x")(1) * 1), 3)
c.Offset(, 1).NumberFormat = "#,##0.00"
Select Case c.Offset(, 1).Value
Case Is <> 0.8
c.Offset(, 1).Font.Color = vbRed
End Select
End If
Next
End Sub
Private Function NETTOYER_B(txt As String) As String
Dim i%
For i = 1 To Len(txt)
If AscW(Mid(txt, i, 1)) < 127 Then NETTOYER_B = NETTOYER_B & Mid(txt, i, 1)
Next i
End Function

 

[Staple1600]

Re

=>gbinforme
J'ai testé ton code
Mon code met en rouge, pas le le tien pour certains cas particulier
Exemple
=1230/1536 donne 0,80078125
On mets en rouge ou pas?
Mon code oui, le tien non

Piaf79, tu peux trancher la chose, stp?

 

[Piaf79]

Re

=>gbinforme
J'ai testé ton code
Mon code met en rouge, pas le le tien pour certains cas particulier
Exemple
=1230/1536 donne 0,80078125
On mets en rouge ou pas?
Mon code oui, le tien non

Piaf79, tu peux trancher la chose, stp?

Non 1230/1536 ne doit pas être en rouge.
Tout ce qui est à 0,80 sans arrondi doit être considéré comme bon.
P79

 

[Piaf79]

Merci Staple1600 et Gbinforme pour votre collaboration et aide précieuse !