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

Piaf79

XLDnaute Junior
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
 

Pièces jointes

  • Exemple.xlsx
    9.5 KB · Affichages: 18

Staple1600

XLDnaute Barbatruc
Bonjour le fil

Test OL sur l'échantillon du fichier exemple
(Sélectionnez la plage D2:D7 avant de lancer la macro)
VB:
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

XLDnaute Junior
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

XLDnaute Barbatruc
Re

Comme c'est déjà fait, je poste ;)
(évidemment, il faut garder la fonction nettoyer dans le projet VBA)
VB:
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
 

gbinforme

XLDnaute Impliqué
Bonjour,

Tes données sont assez complexe mais voici une autre solution qui devrait répondre à ton souhait :
VB:
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
 

Pièces jointes

  • Exemple.xlsm
    16.6 KB · Affichages: 3

Staple1600

XLDnaute Barbatruc
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.
VB:
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
 
Dernière édition:

Discussions similaires