[VBA] Remplissage automatique cellule différente avec date plus ancienne

choup67

XLDnaute Occasionnel
Bonjour à tous,

Je sèche un peu sur une macro et je fais donc appel à vous.

J'ai une liste de date en colonne A qui sont entrecoupées de nombre. Je voudrais que chaque ligne qui contient un nombre, remplace la valeur de la cellule par la date la plus ancienne trouvée dans les lignes suivantes jusqu'au prochain nombre.

Exemple :
Données de base
Colonne A
12
01/01/2013
15/01/2013
17
22/01/2013
10/01/2013
08/01/2013
19/01/2013
22
15/01/2013
01/01/2013

Résultat souhaité
Colonne A
01/01/2013
01/01/2013
15/01/2013
08/01/2013
22/01/2013
10/01/2013
08/01/2013
19/01/2013
01/01/2013
15/01/2013
01/01/2013

Jusque là, j'ai réussi à récupérer la 1ère date en dessous des nombres, mais ce n'est pas toujours la plus ancienne.
Code:
    ' Rempalcer les constantes par rien sur les cellules texte
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeConstants, 1).Select
    Selection.ClearContents
' Remplissage auto des dates manquantes
    Columns("A:A").Select
    Selection.SpecialCells(xlCellTypeBlanks).Select
    Selection.FormulaR1C1 = "=R[1]C"

Ci-joint un fichier exemple, ce sera plus clair.

Merci pour votre aide.
 

Pièces jointes

  • choup67_remplissage-auto-date-ancienne.xlsx
    10.2 KB · Affichages: 65

PMO2

XLDnaute Accro
Re : [VBA] Remplissage automatique cellule différente avec date plus ancienne

Bonjour,

Essayez avec le code suivant.
Les données doivent commencer en A1.
Code:
Sub aa()
Dim R As Range
Dim var
Dim i&
Dim g&
Dim maDate As Date
Set R = Range("a1:a" & [a65536].End(xlUp).Row & "")
var = R
For i& = 1 To UBound(var, 1)
  If Not IsDate(var(i&, 1)) And IsNumeric(var(i&, 1)) Then
    g& = i& + 1
    If g& > UBound(var, 1) Then Exit For
    Do Until Not IsDate(var(g&, 1))
      If maDate = 0 Then
        maDate = var(g&, 1)
      Else
        If maDate > var(g&, 1) Then maDate = var(g&, 1)
      End If
      g& = g& + 1
      If g& > UBound(var, 1) Then Exit Do
    Loop
    If maDate > 0 Then
      var(i&, 1) = maDate
      maDate = 0
    End If
  End If
Next i&
'--- Inscription en colonne C ---
Set R = R.Offset(0, 2)
R = var
End Sub
 

choup67

XLDnaute Occasionnel
Re : [VBA] Remplissage automatique cellule différente avec date plus ancienne

Bonjour PM02 et merci pour ton aide.

J'avoue que mon niveau de VBA est très bas et je ne comprends pas grand chose à ton code mais cela fonctionne et j'ai réussi à l'adapter à mon fichier d'origine :)
 
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 166
Messages
2 085 898
Membres
103 022
dernier inscrit
Ouékino