Remplacement de format dans beaucoup de cellules

Version imprimable

06/05/2022, 11h46
nemog

Remplacement de format dans beaucoup de cellules

Bonjour,

Je connais un peu VBA pour Access et vais sûrement m'y mettre pour Excel
Mais par manque de temps, je pose une question ici parce que je n' ai pas trouvé de moyen simple de le faire :

J'ai un classeur XL imbuvable avec des dizaines de feuilles
Sur certaines, il y a des cellules contenant un nombre au format texte ## ## ##
Je voudrais transformer le format de ces cellules en ######

J'ai essayé par l'intermédiaire du CTRL-H mais sans succès (peut-être est-ce faisable quand même ?)

ou peut-on m'écrire un pitit code siouplait ? :oops:

Merci, cordialement

Nemog

Bonjour,

Oui, c'est bizarre que Ctrl-h ne permette pas de le faire. Aussi ce code qui va chercher dans la feuille active toutes les cellules où il se trouve un nombre qui à la forme xx xx xx et le transforme en nombre xxxxxx. Ne marche que s'il y a vraiment 6 chiffres.
Code:

1 2 3 4 5 6 7 8 9 10 11 Option Explicit Sub TextEnNombre() Dim c As Range For Each c In ActiveSheet.UsedRange If c Like "## ## ##" Then c.Replace What:=" ", Replacement:="" c.NumberFormat = "0" End If Next c End Sub
Cordialement.

06/05/2022, 20h45
Qwazerty

Salut

La forme ## ## ## est imposée par une mise en forme du format de la cellule ou est ce que les espaces entre les chiffres sont réellement présents?

++
Qwaz
06/05/2022, 21h07
nemog

en creusant un peu plus, j'ai l'impression que ça a été écrit comme ça, pas vraiment un format imposé
mais j'essaie d'imposer une règle : tout ce qui se présente comme 21 ## ## doit devenir 21####

mes tentatives semblent se heurter à un "verrouillage", mais ni les cellules ni les feuilles ne semblent l'être !
et j'ai aussi cherché dans les propriétés du fichier

grrrrrrr !

merci Qwazerty ;)

Merci EricDGN, mais je ne pourrai essayer que lundi ;)

Cordialement

Nemog
06/05/2022, 21h20
Qwazerty
Tu n'a pas moyen de nous donner un extrait anonymisé du fichier?
Si toutes les valeurs commencent par "21 "
Tu peux essayer de faire en 2 étapes
1. Tu fais une recherche de toutes les cellules commençant par "21 " (Ctrl+F et tu recherches "21 *". Tu sélectionnes ensuite toutes les valeurs qu'Excel te retourne dan la liste de la fenêtre de recherche.
2. En gardant la sélection, tu fais un remplacement du caractère " " (espace) par "" (vide)
Excel devrait retrouver les formats numériques et te proposer de changer le format "text" en format "numéric"

++
Qwaz

Bonjour,

Attention, si ces nombres sont des dates au format aa mm jj, alors c'est plutôt ceci qu'il faudrait utiliser, pour changer cela dans toutes les feuilles:

Code:

1
2
3
4
5
6
7
8
9
10
11
Sub EnDates()
    Dim wSh As Worksheet, c As Range
    For Each wSh In ThisWorkbook.Worksheets
        For Each c In wSh.UsedRange
            If c Like "## ## ##" Then
                c = CDate("20" & Replace(c, " ", "-"))
                c.NumberFormat = "dd/mm/yyyy"
            End If
        Next c
    Next wSh
End Sub

(dates supposées être toutes après l'an 2000).

Cordialement.

09/05/2022, 11h21
nemog

3 pièce(s) jointe(s)

Pièce jointe 618767 Pièce jointe 618768 Pièce jointe 618769

Merci

Le 1er code ci dessus est, me semble-t-il, ce qui me conviendrait (je ne sais pas comment le déclencher :oops:)

Mais je pense qu'il y a un autre problème avant - voir copies d' écran
XL ne trouve pas ce que je veux selectionner
Les cellules visibles ici étaient verrouillées, je les ai dévérrouillées

1 pièce(s) jointe(s)

Bonjour,

Ctrl-H ne fonctionne pas avec les jokers. Ouvrir la feuille concernée et lancer cette macro:

Code:

1
2
3
4
5
6
7
8
Sub EnNombre2()
    Dim c As Range
    For Each c In ActiveSheet.UsedRange
        If c Like "## ## ##*" Then
            c = Replace(Left(c, 8), " ", "") & IIf(Len(c) > 8, Mid(c, 9), "")
        End If
    Next c
End Sub

Cordialement.

09/05/2022, 15h38
jurassic pork

1 pièce(s) jointe(s)

Hello,
il y a aussi possibilité d'utiliser des expressions régulières en code VBA.
Exemple d'un formulaire qui appelle du code VBA avec des expressions régulières :

Pièce jointe 618779

Ami calmant, J.P
09/05/2022, 18h21
Qwazerty

3 pièce(s) jointe(s)

Citation:

Envoyé par nemog

Mais je pense qu'il y a un autre problème avant - voir copies d' écran
XL ne trouve pas ce que je veux selectionner
Les cellules visibles ici étaient verrouillées, je les ai dévérrouillées

Voila les étapes que je te proposai de réaliser
Pièce jointe 618793 Pièce jointe 618794 Pièce jointe 618795
(Sur le dernier screenshot, comme indiqué dans mon message précédent, le champ "Rechercher" contient juste un espace et le champ "Remplacer par" reste vide)

Au pire, tu peux faire un enregistrement macro et reproduire sur les autres classeur. Mais bon, plusieurs codes ont été proposés et je ne doute pas de leur pertinence.
Sache quand même que cette opération peut se faire d'un coup sur l'ensemble du classeur en choisissant "Classeur" dans la liste déroulante située dans les options de la fenêtre de recherche (elles sont visibles sur le dernier screenshot).
A faire à la main, ça prend 1 min ou deux, du VBA c’est intéressant si tu as beaucoup de classeur à traiter.

++
Qwaz
++
Qwaz
10/05/2022, 11h10
nemog

Merci beaucoup à tous, vous vous donnez vraiment du mal ! bravo

@Qwaz : effectivement ta méthode marche très bien pour peu qu'on la respecte scrupuleusement,
C'est très bien décrit, mais un peu fastidieux pour le nompbre de feuilles que j'ai dans le classeur et ne marche pas si les cellules sont verrouillées
(il faudrait passer sur chaque feuille pour deverrouiller si nécessaire)

Du coup j'ai "combiné" les 2 codes de EricDgn (le 1er était ce qu'il fallait, et le 2e devrait m'apprendre comment le faire dans tout le classeur d'un seul coup)
Mais ça ne marche pas pour tout le classeur

Faut-il remplacer "ThisWorkBook" par .... ?

2 pièce(s) jointe(s)

Hello,
voici le code d'un formulaire pour faire une recherche et un remplacement sur la la feuille active ou toutes les feuilles d'un classeur, en utilisant les expressions régulières :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
Private Sub CmdReplace_Click()Dim oRegExp As Object, oRegMatches As Object
Dim c As Range
Dim ColSheets As New Collection
Dim nbrep As Integer
Me.Status = ""
nbrep = 0
Set oRegExp = CreateObject("vbscript.regexp")
oRegExp.Pattern = Me.TbSearch.Text
If Me.opt_AllSheets Then
    For Each wSh In ThisWorkbook.Worksheets
        ColSheets.Add wSh
    Next
Else
    ColSheets.Add ActiveSheet
End If
For Each wSh In ColSheets
    'wSh.Unprotect()
    If Me.opt_AllSheets Then
      Me.Status.Text = Me.Status.Text + wSh.Name + " : "
    End If
    For Each c In wSh.UsedRange
        Set oRegMatches = oRegExp.Execute(c)
        If oRegMatches.Count > 0 Then
            Me.Status.Text = Me.Status.Text + CStr(c.Address) + " - "
            c = oRegExp.Replace(c, Me.TbReplace.Text)
            nbrep = nbrep + 1
        End If
    Next c
   'WSh.Protect()
Next
Me.Status.Text = Me.Status.Text + vbCrLf + "**** Nb de remplacements : " & CStr(nbrep)
Set oRegExp = Nothing
Set ColSheets = Nothing
End Sub
 
 
Private Sub CmdSearch_Click()
Dim oRegExp As Object, oRegMatches As Object
Dim wSh As Worksheet, c As Range
Dim myUnion As Range
Dim nbrep As Integer
Dim ColSheets As New Collection
Me.Status = ""
nbrep = 0
Cells(1, 1).Select
Set oRegExp = CreateObject("vbscript.regexp")
oRegExp.Pattern = Me.TbSearch.Text
If Me.opt_AllSheets Then
    For Each wSh In ThisWorkbook.Worksheets
        ColSheets.Add wSh
    Next
Else
    ColSheets.Add ActiveSheet
End If
For Each wSh In ColSheets
    If Me.opt_AllSheets Then
      Me.Status.Text = Me.Status.Text + wSh.Name + " : "
    End If
    For Each c In wSh.UsedRange
        Set oRegMatches = oRegExp.Execute(c)
        If oRegMatches.Count > 0 Then
            If Me.opt_ActiveSheet Then
                If Not myUnion Is Nothing Then
                    Set myUnion = Union(myUnion, c)
                Else
                    Set myUnion = c
                End If
            End If
            Me.Status.Text = Me.Status.Text + CStr(c.Address) + " - "
            nbrep = nbrep + 1
        End If
    Next c
Next
Cells(1, 1).Select
If Me.opt_ActiveSheet Then myUnion.Select
Me.Status.Text = Me.Status.Text + vbCrLf + "**** Résultats trouvés : " & CStr(nbrep)
Set oRegExp = Nothing
Set ColSheets = Nothing
End Sub

La déprotection des feuilles (Unprotect) qui permet de déverrouiller des cellules verrouillées et la protection des feuilles (Protect) est mise en commentaire car peut nécessiter un mot de passe.

Pièce jointe 618831

En pièce jointe un classeur avec le formulaire, son code et une macro pour lancer le formulaire (RechercherRemplacer)
Exemple d'expression régulières pour la recherche :
^21 cherche une chaîne commençant par 21
(\d+)\s+(\d+)\s+(\d+) cherche un nombre constitué d'un ou plusieurs chiffres suivi d'un espace (ou plus) suivi d'un nombre constitué d'un ou plusieurs chiffres suivi d'un espace (ou plus) suivi d'un nombre constitué d'un ou plusieurs chiffres. Les 3 nombres sont capturés (les parenthèses) dans des groupes.
Exemple d'expression régulière pour le remplacement :
$1$2$3 : premier groupe capturé suivi du deuxième groupe capturé suivi du troisième groupe capturé ( voir animation de mon message précédent).

Ami calmant, J.P

10/05/2022, 13h26
nemog

Merci jp, ça fait un peu beaucoup pour moi, mais je vais essayer de comprendre

Mais d' après mes essais de ce matin, le code passait outre le verrouillage des cellules

Je cherchais juste à comprendre s'il fallait adapter la phrase

Code:

For Each wSh In ThisWorkbook.Worksheets

à mon classeur particulier
A priori non, donc il faut que je voie pourquoi ou que je lance la macro dans chaque feuille
10/05/2022, 13h32
jurassic pork

Citation:

Envoyé par nemog

Du coup j'ai "combiné" les 2 codes de EricDgn (le 1er était ce qu'il fallait, et le 2e devrait m'apprendre comment le faire dans tout le classeur d'un seul coup)
Mais ça ne marche pas pour tout le classeur

Peux-tu nous montrer ton code ?

Code:

1
2
3
4
5
6
7
8
9
Dim wSh As Worksheet, c As Range
     For Each wSh In ThisWorkbook.Worksheets
        For Each c In ActiveSheet.UsedRange
       	   If c Like "## ## ##" Then
            	c.Replace What:=" ", Replacement:=""
            	c.NumberFormat = "0"
            End If
    	 Next c
      next wsh

Si Activesheet.usedrange ne désigne que la feuille visible, ça pourrait expliquer l’échec de la manip dans tout le classeur (!?)

10/05/2022, 15h58
EricDgn

Oui, c'est bien ce que relève nemog, en ligne 3 il faut écrire:

Code:

For Each c In wSh.UsedRange

Cdt
11/05/2022, 09h32
nemog

ouf ! c'est bon !

Merci Eric, merci à tous :)