macro avec une formule

  • Initiateur de la discussion Initiateur de la discussion kaynan
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

kaynan

XLDnaute Nouveau
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.
 

Pièces jointes

Re : macro avec une formule

Bonjour,

en attendant mieux
VB:
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
 
Re : macro avec une formule

Bonjour kaynan, st007,

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

Code:
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+
 

Pièces jointes

Re : macro avec une formule

Bonjour kaynan, st007,

Une solution par tableaux VBA :

Code:
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+
 

Pièces jointes

Dernière édition:
Re : macro avec une formule

Re,

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

Code:
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+
 

Pièces jointes

- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
7
Affichages
480
Réponses
8
Affichages
466
Réponses
7
Affichages
163
Retour