les tableaux / les 'ranges'

[Philippe63000]

Bonsoir,

Je travaille avec deux colonnes. La première colonne (à partir de A4) contient des dates et la deuxième colonne (à partir de B4) contient des quantités. A chaque date correspond donc une quantité.
Les dates doivent se suivrent (01/01/2000 puis 02/01/2000 puis 03/01/2000 etc...). Mais dans la base de données de départ les colonnes (à ma disposition) peuvent présenter des manques.La colonne des dtes peut avoir 2 dates consécutives avec un delta de plus d'un jour (par exemple :01/01/2010 puis 05/01/2010 puis 06/01/2010 etc...). Je dois donc rajouter ces dates manquantes afin que la différence entre deux dates quelconques de la colonne A soit de 1 jour.Chaque date ajoutée devra présenter une quantité. Cette quantité sera la moyenne des quantités correspondant aux dates trouvées (exemple :
01/01/2010 10
05/01 /2010 20
on doit ajouter 3 dates et à chacune de ces dates on associera la quantité 10+20)/2 =15
02/01/2010 15
03/01/2010 15
04/01/2010 15

De même il se peut que dans la base de données initiales certaines dates ne présentent pas de quantitié. Il faudra donc remplir ces manques de la même façon que précédemment.
01/01/2000 10
02/01/2000
03/01/2000
04/01/2000 6
il faudra mettre (10+6)/2=8 à côté de 02/01/2000 et de 03/01/2000.

Je pensais utiliser des tableaux pour faire le travail. Un tableau pour la base de données initiale. Et un tableau qui serait construit à parrtir du premier et auquel on ferait subir les changements voulus.
sub test()
dim tblo ' tableau qui contiendra la base de données initiale
derniere_ligne= range("A65536").End(xlup).row
with worksheets("Feuil1")
with .range ("A4:B"& derniere_ligne)
tblo=.value
end with
end sub
mais je devrai redimentionner le nouveau tableau tblo_nouveau() et je dois dire que je suis un peu perdu .


J'ai aussi pensé à utiliser des plages de données . Mais je domine encore moins ce domaine.

Quelle méthode choisiriez-vous?

Merci pour votre aide,

Cordialement

 

[vgendron]

Re : les tableaux / les 'ranges'

Bonjour,
essaie ceci
méthode: commence par ajoutter les dates manquantes
puis met les valeurs..

sinon j'ai bien une idée bien plus rapide mais je ne sais pas encore comment faire.. je cherche et reviens.

 

[camarchepas]

Re : les tableaux / les 'ranges'

Bonjour Vgendron , Philippe,
une piste pourrait être l'utilisation d'un dictionnaire ou la date serait la clef et la quantité la valeur.
A voir ensuite l'utilisation d'une boucle pour le remplissage du dico,
puis d'une 2° boucle pour la restitution et le complément d'info.

Pas trop le temps ce matin, j'essaie prochainement de vous proposer un code, le dico étant vraiment très rapide en recherche de clef

 

[Philippe63000]

Re : les tableaux / les 'ranges'

Bonjour,
Merci à tous les deux

 

[Philippe63000]

Re : les tableaux / les 'ranges'

Bonsoir,

Suite à vos idées j'aurais une question de plus. Comment se débarasser de la mise en tableau de la plage ainsi que du formatage des cellules et de l'entête.

Sub Macro1()

ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$B$5"), , xlNo).Name = _
"Tableau1"
Range("Tableau1[#All]").Select
ActiveSheet.ListObjects("Tableau1").TableStyle = "TableStyleLight8"

End Sub

Unlist ?

Cordialement

 

[Bebere]

Re : les tableaux / les 'ranges'

bonjour Philippe,CaMarchePas,Vgendron
un essai en partant du classeur de Vgendron

 

[Efgé]

Re : les tableaux / les 'ranges'

Bonjour Philippe, CaMarchePas , Vgendron, Bebere
Une proposition :

Private Sub CommandButton1_Click()
Dim i&, Mn&, Mx&, C, TabDat, D As Object, R As Range
Set D = CreateObject("Scripting.Dictionary")
TabDat = Range(Cells(4, 1), Cells(Rows.Count, 1).End(3)(1, 2))

For i = LBound(TabDat, 1) To UBound(TabDat, 1)
    TabDat(i, 1) = CLng(TabDat(i, 1))
Next i

With Application
    Mn = .Min(.Index(TabDat, , 1))
    Mx = .Max(.Index(TabDat, , 1))
End With

For i = Mn To Mx:   D(i) = "":   Next i

For i = LBound(TabDat, 1) To UBound(TabDat, 1)
    D(TabDat(i, 1)) = CLng(TabDat(i, 2))
Next i

Application.ScreenUpdating = False
With Cells(4, 5).Resize(D.Count, 1)
    .Value = Application.Transpose(D.Keys)
    .NumberFormat = "m/d/yyyy"
    With .Offset(, 1)
        .Value = Application.Transpose(D.Items)
        For Each R In .SpecialCells(4).Areas
            Mn = R.Offset(-1, 0)(1, 1)
            Mx = R.Offset(R.Rows.Count, 0)(1, 1)
            R.Value = CDbl((Mn + Mx) / 2)
            R.Font.ColorIndex = 3 'Fioriture
        Next R
    End With
End With
Application.ScreenUpdating = True
End Sub

Ce qui me surprend c'est d'être obligé de transformer les dates en "Long"

Si vous avez des remarques, je suis, bien évidemment, preneur (surtout sur ce problème de gestion de date)
Cordiallement