XL 2016 Ne garder que les chiffres dans la colonne A et remplacer les h et '

Kelbret

XLDnaute Nouveau
Bonjour à tous,

Je me heurte à un problème enfin plutôt deux.

Le premier est que je souhaite supprimer tous les caractères autres que des chiffres dans la colonne A de mon fichier.

Individu 7909: NOM1, PRENOM1Info1
1346​
230h23'430h07'090h56'760h06'97
67,5​
Info9
7977​
47h59'750h09'900h57'970h09'59
90,9​
Individu 7902: NOM2, PRENOM2Info2
2119​
230h53'330h05'070h74'770h04'77
76,4​
Info7
9097​
77h45'050h00'560h04'750h00'47
77,4​
Individu 7920: NOM3, PRENOM3Info3
1872​
253h53'540h05'060h59'000h05'77
66,7​
Info4
7776​
59h06'540h07'470h75'490h07'94
97,9​
Individu 7927: NOM4, PRENOM4Info4
2216​
245h22'230h07'560h77'700h07'47
66,9​
Info5
9797​
47h79'770h07'790h57'570h09'77
79,9​
Individu 5977: NOM5-COMPOSE5, PRENOM5Info5
349​
33h25'430h06'760h49'090h06'99
66,7​
Info6
779​
9h40'540h07'450h06'970h07'79
77,7​
Individu 6975: NOM6 COMPOSE6, PRENOM6Info6
1160​
233h34'230h07'040h40'590h05'79
65,9​
Info7
7749​
77h75'470h07'450h75'790h07'97
76​

J'aurais bien la solution de JP14 :

VB:
Dim val1 As String
Dim i As Long
Dim cell As Range
Dim oldCalculation As Variant '
Dim reponse As Variant

oldCalculation = Application.Calculation
Application.Calculation = xlCalculationManual

'expression.InputBox(Prompt, Title, Default, Left, Top, HelpFile, HelpContextId, Type)
On Error GoTo suite
Set reponse = Application.InputBox(Prompt:="Veuillez sélectionner la zone à convertir", Type:=8, Default:="")

Application.ScreenUpdating = False 'gele l'ecran
Application.EnableEvents = False
Application.DisplayAlerts = False 'interdit les messages d'avertissements

For Each cell In reponse
    If cell = "" Then
    Else
        val1 = ""
        For i = 1 To Len(cell)
            If Asc(Mid(cell, i, 1)) > 47 And Asc(Mid(cell, i, 1)) < 59 Then val1 = val1 & Mid(cell, i, 1)
        Next
        cell = val1
    End If
Next cell
fin:
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = oldCalculation
'Application.DisplayAlerts = True ' par défaut
Exit Sub
suite:
Resume fin
End Sub

Mais elle ne fait pas le remplacement automatique dans la colonne A il faut sélectionner la zone et le résultat renvoyé n'est pas sous forme de nombre.


Pour mon deuxième problème j'ai bien essayé avec l'enregistreur de macro, cela fonctionne pas mal sauf pour les cases où il manque un 0 dans les heures.

VB:
Sub Remplacerhetguillemets()
'
' Macro2 Macro
'

'
    Sheets("Résultat voulu").Select
    Columns("B:O").Select
    Selection.Replace What:="'", Replacement:=":", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.Replace What:="h", Replacement:=":", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False, FormulaVersion:=xlReplaceFormula2
    Selection.NumberFormat = "[$-x-systime]h:mm:ss AM/PM"
    Range("F4").Select
    ActiveCell.FormulaR1C1 = "0:77:70"
    Range("F5").Select
    Sheets("Source").Select
End Sub


Auriez-vous une piste à me donner pour que je puisse trouver la solution à mes problèmes.

Merci d'avance !
 

Pièces jointes

  • Test.xlsm
    21.1 KB · Affichages: 7
Solution
Bonjour,

Pour "ne garder que les chiffres", je te propose ceci :
VB:
Sub GarderChiffres()
'
    Application.ScreenUpdating = False
    Set MaCel = Sheets("Source").Range("A1")
    i = 0
    While MaCel.Offset(i, 0).Value <> ""
        Retour = ""
        j = 1
        While Mid(MaCel.Offset(i, 0).Value, j, 1) <> ":"
            MonCode = Mid(MaCel.Offset(i, 0).Value, j, 1)
            If Asc(MonCode) > 47 And Asc(MonCode) < 58 Then Retour = Retour & MonCode
            j = j + 1
        Wend
        MaCel.Offset(i, 0).Value = CDec(Retour)
        i = i + 1
    Wend

End Sub



ça représente quoi 9'90 ??? 10'30'' ?

Et comment "230h23'43" devient "14:23:43" ???

etc. etc. etc.

TooFatBoy

XLDnaute Barbatruc
Bonjour,

Pour "ne garder que les chiffres", je te propose ceci :
VB:
Sub GarderChiffres()
'
    Application.ScreenUpdating = False
    Set MaCel = Sheets("Source").Range("A1")
    i = 0
    While MaCel.Offset(i, 0).Value <> ""
        Retour = ""
        j = 1
        While Mid(MaCel.Offset(i, 0).Value, j, 1) <> ":"
            MonCode = Mid(MaCel.Offset(i, 0).Value, j, 1)
            If Asc(MonCode) > 47 And Asc(MonCode) < 58 Then Retour = Retour & MonCode
            j = j + 1
        Wend
        MaCel.Offset(i, 0).Value = CDec(Retour)
        i = i + 1
    Wend

End Sub



ça représente quoi 9'90 ??? 10'30'' ?

Et comment "230h23'43" devient "14:23:43" ???

etc. etc. etc.
 
Dernière édition:

Phil69970

XLDnaute Barbatruc
Bonjour @Kelbret
Edit bonjour @TooFatBoy tu m'as grillé !!! 🤣

Tu poses 2 questions qui n'ont rien à voir l'une avec l'autre.
Le principe du forum c'est :
==>une question ==> une ou plusieurs réponses ==> je valide la réponse qui me va et que j'ai retenu
==> Nouvelle question ==> une ou plusieurs réponses==> je valide la réponse qui me va et que j'ai retenu....

Au fond de mes cartons j'avais ceci pour ta 1ere question

Merci de ton retour

@Phil69970
 

Pièces jointes

  • Garder les chiffres V1.xlsm
    22.9 KB · Affichages: 9

Kelbret

XLDnaute Nouveau
Hello TooFatboy ! Content de te voir à nouveau !

Ah oui elle est impec ta formule :O Merci beaucoup!!

Ah oui mince en effet en voulant changer aléatoirement les chiffres j'ai complètement oublié que ça ne fonctionnait pas le format heure avec 00:09:90 ce serait plutôt 00:09:57 par exemple.

Je joins un fichier rectifié. Désolé :S
 

Pièces jointes

  • Test.xlsm
    21.5 KB · Affichages: 3

Kelbret

XLDnaute Nouveau
Hello TooFatboy ! Content de te voir à nouveau !

Ah oui elle est impec ta formule :O Merci beaucoup!!

Ah oui mince en effet en voulant changer aléatoirement les chiffres j'ai complètement oublié que ça ne fonctionnait pas le format heure avec 00:09:90 ce serait plutôt 00:09:57 par exemple.

Je joins un fichier rectifié. Désolé :S
Au temps pour moi Phil69970 ! C'était surtout pour éviter de créer deux sujets différents alors que je recherche une macro qui permet de faire les deux en un seul coup
 

Phil69970

XLDnaute Barbatruc
Re

C'était surtout pour éviter de créer deux sujets différents
Justement tu le dis toi même c'est 2 sujets différents.

Et perso
alors que je recherche une macro qui permet de faire les deux en un seul coup
Vouloir traiter les 2 en même temps ne me semble dans un 1er temps pas forcément la bonne solution
Je verrais plutôt un code qui fait la 1ere solution puis qui appelle la macro 2 qui traite la suite du fichier

@Phil69970
 

patricktoulon

XLDnaute Barbatruc
Bonjour jouer avec les chaine de caractères dans les cellules peut être très gourmand
une boucle sur le len(chaine) est le plus souvent utilisé en vba
cela dit on peut se reduire le moulin et sa consommation
en arrêtant la boucle des que la condition ne correspond pas ( en l'occurence ici un chiffre)
en utilisant une forme de boucle utilisant le moins de if et autres conditions
en evitant le concat de caratères quand il correspondent(les fonctions string sont gourmande )

perso putot que des boucle for i = 1 to len(chaine) avec concat du caractère à chaque tour
je préfère de loin utiliser une boucle do /loop avec until
et tester la valeur avec la fonction basique vba (val)sur le mid(chaine,x)


ainsi on sort de la boucle par la condition "until" des que la valeur de mid(chaine,x) >0

pour les débutants qui comprendraient pas
Code:
sub test()
chaine="toto et titi569845et riri et fifi et peut être même loulou"

msgbox val(mid(chaine,13))

end sub

donc perso j'aurais fait ceci
VB:
Sub Supprimertouslescaracteressaufchiffres()
Dim val1&, i&, cell As Range, oldCalculation As Variant, reponse As Variant

    With Application
        oldCalculation = .Calculation:        .Calculation = xlCalculationManual
        .ScreenUpdating = False                       'gele l'ecran
        .EnableEvents = False
        .DisplayAlerts = False                        'interdit les messages d'avertissements

        For Each cell In Feuil1.[a1].Resize(Feuil1.UsedRange.Rows.Count)
            If cell <> "" Then
                val1 = 0: i = 0
                Do Until val1 > 0
                    i = i + 1: val1 = Val(Mid(cell.Text, i))
                Loop
                cell = val1
            End If
        Next cell
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = oldCalculation
        '.DisplayAlerts = True ' par défaut
    End With
End Sub
 

patricktoulon

XLDnaute Barbatruc
j'oubliais
pour les "h" et "'" dans la colonne "D"
VB:
Sub Supprimertouslescaracteressaufchiffres()
Dim val1&, i&, cell As Range, oldCalculation As Variant, reponse As Variant

    With Application
        oldCalculation = .Calculation:        .Calculation = xlCalculationManual
        .ScreenUpdating = False                       'gele l'ecran
        .EnableEvents = False
        .DisplayAlerts = False                        'interdit les messages d'avertissements

        For Each cell In Feuil1.[a1].Resize(Feuil1.UsedRange.Rows.Count)
            If cell <> "" Then
                val1 = 0: i = 0
                Do Until val1 > 0
                    i = i + 1: val1 = Val(Mid(cell.Text, i))
                Loop
                cell = val1
            End If
        Next cell
       
       With Feuil1.Columns("D:G").Resize(Feuil1.UsedRange.Rows.Count)
       .Replace "h", ":"
       .Replace "'", ":"
       End With
     
       .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = oldCalculation
        '.DisplayAlerts = True ' par défaut
    End With
End Sub
 
Dernière édition:

Kelbret

XLDnaute Nouveau
Bonjour PatrickToulon, j'ai bien essayé avec la macro de TooFatBoy et elle fonctionne bien pour supprimer les chiffres.

Mais quand j'ai essayé la tienne cela me ressort une erreur, j'ai pourtant bien renommé ma feuille en Feuil1, mais il y a peut-être quelque chose qui m'échappe?

Cela me met Objet Requis et cela surligne :

VB:
       For Each cell In Feuil1.[a1].Resize(Feuil1.UsedRange.Rows.Count)
 

TooFatBoy

XLDnaute Barbatruc
Dernière édition:

Phil69970

XLDnaute Barbatruc
Re

En revanche, il fait ce que demande la question, mais il ne fait pas ce qu'il faut...

1671477377950.png


Il garde bien les chiffres de chaque cellule de la colonne A il me semble.

Il a mis comme exemple :
7909: NOM1, PRENOM1 ==> Réponse de la macro 770911
donc pour moi la macro a bien fait son travail de garder les chiffres car dans la réalité il doit avoir :
7909: DUPONT, JEAN ==> Réponse de la macro 7709

@Kelbret à bien résumé en fait ;)

1671477278617.png


@Phil69970
 

Statistiques des forums

Discussions
311 725
Messages
2 081 940
Membres
101 845
dernier inscrit
annesof