Microsoft 365 VBA TEST NB DE CARACTERE DANS LES CELLULES PLAGE VARIABLE

[chris6999]

Bonjour

Depuis hier je cherche le code me permettant de tester sur une plage le nombre de caractères contenus dans les cellules d'une plage variable.

Mon besoin est le suivant :
2 colonnes A et B
Pour chaque colonne, la plage à balayer partirait de la dernière ligne non vide jusqu'à la ligne 10.
Test à réaliser : pour chaque cellule de la plage vérifier que le nombre de caractères est égal à la valeur mentionnée ligne 2 (col A 14 caractères attendus, 15 pour la colonne B).

Si le nb attendu n'est pas atteint dans une cellule mettre en surbrillance les cellules incorrectes

Je mets un fichier test en PJ en espérant que vos neurones seront plus efficaces que les miens ...
Merci par avance pour vos réponses.

 

[chris]

Bonjour

Pourquoi ne pas mettre mettre une validation et afficher les cercles entourant les données non valides ?
A noter que ta 1ère colonne contient 15 caractères partout sauf 1 cellule et idem pour la seconde

Également possible par MFC

 

[laurent950]

Bonjour chris6999, chris, Le forum.

une Solution :

Sub test()
Dim FD As Worksheet
    Set FD = Worksheets(ActiveSheet.Name)
Dim TbBis(1 To 2) As Variant
        TbBis(1) = FD.Range("A10:B" & FD.Range("B1048576").End(xlUp).Row).Value
    Set TbBis(2) = FD.Range("A10:B" & FD.Range("B1048576").End(xlUp).Row)
' Suppression de la surbrillance
        TbBis(2).Interior.Pattern = xlNone
    For i = LBound(TbBis(1), 1) To UBound(TbBis(1), 1)
        If Len(TbBis(1)(i, 1)) <> 14 Then
            TbBis(2)(i, 1).Interior.Color = 65535
        End If
        If Len(TbBis(1)(i, 2)) <> 15 Then
            TbBis(2)(i, 2).Interior.Color = 65535
        End If
    Next i
' Libére la mémoire
    Erase TbBis
    Set FD = Nothing
    Calc1 = Empty: Calc2 = Empty
End Sub

 

[chris6999]

Bonjour

Pourquoi ne pas mettre mettre une validation et afficher les cercles entourant les données non valides ?
A noter que ta 1ère colonnes contient 15 caractères partout sauf 1 cellule et idem pour la seconde

Également possible par MFC

Bonjour

J'ai déjà des validations prévue lorsque les données sont saisies directement dans le fichier.
Ma préoccupation c'est pour le mode copier coller ...
Mais pourquoi pas je vais creuser l'idée.
Merci

 

[chris6999]

Bonjour chris6999, chris, Le forum.

une Solution :

Sub test()
Dim FD As Worksheet
    Set FD = Worksheets(ActiveSheet.Name)
Dim TbBis(1 To 2) As Variant
        TbBis(1) = FD.Range("A10:B" & FD.Range("B1048576").End(xlUp).Row).Value
    Set TbBis(2) = FD.Range("A10:B" & FD.Range("B1048576").End(xlUp).Row)
' Suppression de la surbrillance
        TbBis(2).Interior.Pattern = xlNone
    For i = LBound(TbBis(1), 1) To UBound(TbBis(1), 1)
        If Len(TbBis(1)(i, 1)) <> 14 Then
            TbBis(2)(i, 1).Interior.Color = 65535
        End If
        If Len(TbBis(1)(i, 2)) <> 15 Then
            TbBis(2)(i, 2).Interior.Color = 65535
        End If
    Next i
' Libére la mémoire
    Erase TbBis
    Set FD = Nothing
    Calc1 = Empty: Calc2 = Empty
End Sub

Bonjour et merci pour la proposition. Je m'en vais tester tout ça..

 

[chris6999]

Après premiers tests cela fonctionne parfaitement.
Je suis ravie merci beaucoup et bonne journée