Discussion :

[yastal]

Bonjour,
Pouvez vous s'il vous plait a m'aider de trouvé une solution pour ma macro qui c'arrête pas si la cellule est vide ce qui fait mon fichier il devient trés lourde.
J'essaye de concatener trois cellule sur trois colonne pour avec la date exp 01/01/2022 mais la macro s'arrete pas et pour les cellule vide elle me mets // jusqu'à 15**** lignes vide
Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
' Datemo Macro modif
'
 
'
    Range("I2").Select
    ActiveCell.FormulaR1C1 = "=+RIGHT(RC[-2],2)"
    Range("J2").Select
    ActiveCell.FormulaR1C1 = "=+MID(RC[-3],5,2)"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=+LEFT(RC[-4],4)"
    Range("L2").Select
    ActiveCell.FormulaR1C1 = "=+CONCATENATE(RC[-3],""/"",RC[-2],""/"",RC[-1])"
    Range("K2").Select
    ActiveCell.FormulaR1C1 = "=+LEFT(RC[-4],4)"
    Range("I2:K2").Select
    Selection.AutoFill Destination:=Range("I2:K" & Range("K" & Rows.Count).End(xlDown).Row)
    Range("L2").Select
    Selection.AutoFill Destination:=Range("L2:L" & Range("K" & Rows.Count).End(xlDown).Row)
    Selection.Copy
    Columns("L:L").Select
    Application.CutCopyMode = False
    Selection.Copy
    Columns("M:M").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Columns("I:L").Select
    Range("L1").Activate
    Application.CutCopyMode = False
    Selection.Delete Shift:=xlToLeft

[hyperion13]

Salut

Une capture d'écran serait la bienvenue pour mieux comprendre. Pas de fichier.

[yastal]

Veuillez trouver les captures d'ecran

[hyperion13]

euh...
quel rapport entre votre macro et la capture de votre worksheet ?

[EricDgn]

Bonjour hyperion13, bonjour yastal,

Si j'ai bien compris, il s'agit de convertir la date présentée dans la cellule G2 sous le format aaaammjj dans le format jj/mm/aaaa. Pour faire cela il suffit d'utiliser cette formule: =DATE(GAUCHE(G2;4);STXT(G2;5;2);DROITE(G2;2)). Comme il y aura une erreur si G2 est vide, compléter la formule pour gérer cette erreur, soit =SIERREUR(DATE(GAUCHE(G3;4);STXT(G3;5;2);DROITE(G3;2));"").
En VBA:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
    Range("H2").FormulaR1C1 = "=IFERROR(DATE(LEFT(RC[-1],4),MID(RC[-1],5,2),RIGHT(RC[-1],2)),"""")"
'ou
    Range("H2").Formula = "=IFERROR(DATE(LEFT(G2,4),MID(G2,5,2),RIGHT(G2,2)),"""")"

Cordialement.

[jurassic pork]

Hello,

Si j'ai bien compris, il s'agit de convertir la date présentée dans la cellule G2 sous le format aaaammjj dans le format jj/mm/aaaa.

c'est ce qu'il me semble aussi. Dans ce cas on peut utiliser les expressions régulières pour réaliser le traitement.
Voici le code d'une fonction (FmtDate) et d'une fonction personnalisée (PFmtDate à utiliser dans une formule) pour réaliser cette opération:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Function FmtDate(MaChaine As String)
Dim RE As Object, ReplacePattern As String, match As Boolean
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "([0-9]{4})([0-9]{2})([0-9]{2})"
ReplacePattern = "$3/$2/$1"
match = RE.Test(MaChaine)
If match Then MaChaine = RE.Replace(MaChaine, ReplacePattern)
FmtDate = MaChaine
End Function
 
Sub TestFmtDate()
Dim i As Integer
i = 1 'ligne de départ = 1
 ' Boucle sur la colonne A jusqu'à cellule vide
 While Not IsEmpty(Cells(i, 1)) ' colonne 1 = colonne A
     Debug.Print FmtDate(Cells(i, 1).Value)
     i = i + 1
 Wend
End Sub
 
 
Function PFmtDate(Cellule As Range)
Dim RE As Object, ReplacePattern As String, match As Boolean
Dim MaChaine As String
MaChaine = Cellule.Text
Set RE = CreateObject("vbscript.regexp")
RE.Pattern = "([0-9]{4})([0-9]{2})([0-9]{2})"
ReplacePattern = "$3/$2/$1"
match = RE.Test(MaChaine)
If match Then MaChaine = RE.Replace(MaChaine, ReplacePattern)
PFmtDate = MaChaine
End Function

Cela consiste à capturer 3 groupes (avec les parenthèses) constitués des 4 premiers chiffres puis les 2 chiffres suivants puis les 2 chiffres suivants les groupes se nomment alors $1 $2 $3
Avec la fonctions replace on les change de place on insérant un / entre chaque groupe.



Ami calmant, J.P

[hyperion13]

Salut jurassic pork, EricDgn
Étrange ce club des "y" qui demandent de l'aide pour manipuler des formules RC en VBA et qui présentent un code qui ne correspond jamais ou si peu à leur worksheet.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
Sub test()
Dim xlWbk As Workbook
Dim xlWsh As Worksheet
Dim lastRow As Long
Dim k As Variant
 
Set xlWbk = ThisWorkbook
Set xlWsh = xlWbk.Worksheets("Feuil1")
 
lastRow = xlWsh.Cells(Rows.Count, 7).End(xlUp).Row
 
k = Cells(2, 12).FormulaR1C1 '=CONCATENATE(RIGHT(RC[-5],2),"/",MID(RC[-5],5,2),"/",LEFT(RC[-5],4))
 
For i = 2 To lastRow
    If xlWsh.Cells(i, 7).Value = vbNullString Then
        xlWsh.Cells(i, 12).Value = ""
        'ou
        'MsgBox "la cellule : " & xlWsh.Cells(i, 7).Address & " est vide !"
        'Exit For
    Else
        xlWsh.Cells(i, 12).FormulaR1C1 = k
    End If
Next i
End Sub

[yastal]

Bonjour les experts,
Pardonnez moi je suis débutant en VBA c'est pour ca je pose ces question
cette formule :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("H2").Formula = "=IFERROR(DATE(LEFT(G2,4),MID(G2,5,2),RIGHT(G2,2)),"""")"

ca me convient mais le problème c'est que ca se répète pas jusqu'à la dernier ligne vide avec un changement de format en date
Pouvez vous s'il vous plait me montrer comment
Je vous remercie
Bien Cordialement

[EricDgn]

Bonjour,

Effectivement il faut ajouter une instruction pour recopier cette formule jusqu'à la dernière ligne. Ici une façon de faire qui recopie la cellule H2 (formule et format) jusqu'au niveau de la dernière ligne utilisée dans la colonne G:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
    Range("H2").Formula = "=IFERROR(DATE(LEFT(G2,4),MID(G2,5,2),RIGHT(G2,2)),"""")"
    Range("H2").Copy Range("H2:H" & Range("G" & Rows.Count).End(xlUp).Row)

Cordialement.