macro avec une formule

[kaynan]

Bonjour,

je voulais savoir si il existe une solution par macro vba pour avoir un résultat dans une autre feuille.

feuille 1 (initiale): dates de mise en forme aaaa/mm/jj. (colonne a).

feuille 2 (souhaitée): dates de mise en forme jj/mm/aaaa. (colonne a).

la formule est : =CONCATENER(DROITE(A2;2);"/";DROITE(GAUCHE(A2;6);2);"/";GAUCHE(A2;4)).

je cherche a avoir le résultat par macro.

merci de votre aide.

 

[st007]

Re : macro avec une formule

Bonjour,

en attendant mieux

Sub Macro()
nbl = Sheets("initiale").Range("A" & Rows.Count).End(xlUp).Row
    Sheets("resultats").Range("A3").FormulaR1C1 = _
        "=CONCATENATE(RIGHT(initiale!RC,2),""/"",RIGHT(LEFT(initiale!RC,6),2),""/"",LEFT(initiale!RC,4))"
    Range("A3").AutoFill Destination:=Range("A3:A" & nbl), Type:=xlFillDefault
End Sub

 

[kaynan]

Re : macro avec une formule

merci pour la réponse et ça marche bien,.

juste peux tu me dire comment parcourir toutes les colonnes?

 

[st007]

Re : macro avec une formule

euh ...
je ne comprends pas bien, tu peux développer...

 

[kaynan]

Re : macro avec une formule

j'ai des dates du 2015/08/01 aux 2015/08/31 donc du A3 AUX A33.....,dans l exemple qu tu m as envoyé il fait juste la première date.

 

[st007]

Re : macro avec une formule

re,

oops, place toi en feuille resultats et lance cette macro ...

 

[st007]

Re : macro avec une formule

Pour illustrer deux méthodes, deux boutons
le filtre ne fonctionne que sur une même feuille, on pourrais bien sure l'utiliser en colonne "ZZZ" puis la coller en feuille 2

 

[job75]

Re : macro avec une formule

Bonjour kaynan, st007,

Voyez le fichier joint et le code de la feuille "resultats" :

Private Sub Worksheet_Activate()
Dim derlig&
derlig = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
If derlig > 2 Then
  Feuil1.Range("A3:A" & derlig).Name = "a" 'la plage est nommée
  With Range("A3:A" & derlig)
    .FormulaArray = "=DATE(LEFT(a,4),MID(a,5,2),RIGHT(a,2))"
    .Value = .Value 'supprime les formules
  End With
  ThisWorkbook.Names("a").Delete
End If
Range("A" & derlig + 1 & ":A" & Rows.Count).Delete xlUp
End Sub

Plutôt que concaténer il vaut mieux utiliser la fonction DATE.

A+

 

[job75]

Re : macro avec une formule

Bonjour kaynan, st007,

Une solution par tableaux VBA :

Private Sub Worksheet_Activate()
Dim derlig&, t, rest(), i&, x
derlig = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
If derlig > 2 Then
  t = Feuil1.Range("A3:A" & derlig + 1) 'au moins 2 items
  ReDim rest(1 To derlig, 1 To 1) 'base 1
  On Error Resume Next
  For i = 1 To derlig
    x = t(i, 1)
    rest(i, 1) = DateSerial(Left(x, 4), Mid(x, 5, 2), Right(x, 2))
  Next
  Range("A3:A" & derlig) = rest
End If
Range("A" & derlig + 1 & ":A" & Rows.Count).Delete xlUp
End Sub

Malgré la boucle elle est plus rapide.

Edit : noter que si la conversion en date n'est pas possible la cellule du résultat est vide.

Fichier (2).

A+

 

[job75]

Re : macro avec une formule

Re,

On peut préférer utiliser ce fichier (3) :

Private Sub Worksheet_Activate()
Dim derlig&, t, rest(), i&, x
derlig = Feuil1.Range("A" & Rows.Count).End(xlUp).Row
If derlig > 2 Then
  t = Feuil1.Range("A3:A" & derlig + 1) 'au moins 2 items
  ReDim rest(1 To derlig, 1 To 1) 'base 1
  On Error Resume Next
  For i = 1 To derlig
    x = t(i, 1)
    rest(i, 1) = CDate(Join(Array(Left(x, 4), Mid(x, 5, 2), Right(x, 2)), "/"))
  Next
  Range("A3:A" & derlig) = rest
End If
Range("A" & derlig + 1 & ":A" & Rows.Count).Delete xlUp
End Sub

A+