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

[Kelbret]

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, PRENOM1

Info1

1346​

230h23'43

0h07'09

0h56'76

0h06'97

67,5​

Info9

7977​

47h59'75

0h09'90

0h57'97

0h09'59

90,9​

Individu 7902: NOM2, PRENOM2

Info2

2119​

230h53'33

0h05'07

0h74'77

0h04'77

76,4​

Info7

9097​

77h45'05

0h00'56

0h04'75

0h00'47

77,4​

Individu 7920: NOM3, PRENOM3

Info3

1872​

253h53'54

0h05'06

0h59'00

0h05'77

66,7​

Info4

7776​

59h06'54

0h07'47

0h75'49

0h07'94

97,9​

Individu 7927: NOM4, PRENOM4

Info4

2216​

245h22'23

0h07'56

0h77'70

0h07'47

66,9​

Info5

9797​

47h79'77

0h07'79

0h57'57

0h09'77

79,9​

Individu 5977: NOM5-COMPOSE5, PRENOM5

Info5

349​

33h25'43

0h06'76

0h49'09

0h06'99

66,7​

Info6

779​

9h40'54

0h07'45

0h06'97

0h07'79

77,7​

Individu 6975: NOM6 COMPOSE6, PRENOM6

Info6

1160​

233h34'23

0h07'04

0h40'59

0h05'79

65,9​

Info7

7749​

77h75'47

0h07'45

0h75'79

0h07'97

76​

J'aurais bien la solution de JP14 :

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.

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 !

 

[TooFatBoy]

Bonjour,

Pour "ne garder que les chiffres", je te propose ceci :

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

---

0h09'90

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

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

etc. etc. etc.

 

[Phil69970]

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

 

[Kelbret]

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

 

[Kelbret]

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]

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

 

[TooFatBoy]

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

A mon avis, il y a incohérence totale entre la feuille source et la feuille du résultat attendu.

Donc si tu ouvres un autre fil de discussion pour ta deuxième question, postes un fichier corrigé à 100 %.

---

Bonjour Phil

 

[patricktoulon]

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

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

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]

j'oubliais
pour les "h" et "'" dans la colonne "D"

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

 

[Kelbret]

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 :

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

 

[Phil69970]

Re

A priori le fichier du post # 3 est invisible

@Phil69970

 

[Kelbret]

Hello Phil en effet la tienne fonctionne bien aussi merci !

 

[TooFatBoy]

A priori le fichier du post # 3 est invisible

Meuh nan, il n'est pas invisible.
En revanche, il fait ce que demande la question, mais il ne fait pas ce qu'il faut...

---

Hello Phil en effet la tienne fonctionne bien aussi merci !

Ah bah nan, c'pô possib' !

C'est soit #2, soit #3 qui fonctionne comme tu veux.

 

[Kelbret]

Disons que je me suis rendu compte que par rapport à mon énoncé celle de Phil fonctionnait bien mais la tienne est plus en accord avec le fichier excel que j'ai donné en pièce jointe

 

[Phil69970]

Re

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

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

@Phil69970