Colpléter des information manquantes

Bonjour je disposes de données qui sont des temps, un temps qui défile, mais la prise de note étant manuelle je n'ai pas pus prendre chaque temps. je me retrouve donc avec une suite de temps en secondes et certain vides :

150/178/0/0/0/184

je dispose ainsi de 60000 données avec des vides assez ponctuels j'aurais aimé savoir s'il était possible de combler c vides en réalisant cette opération de manière automatique:

(184-178)/3=2

puis ajouté a la première case vide ce résultats: 178+2; pour la seconde case vide180+2 et ainsi de suite jusqu'à combler le vide.

Merci par avance

Bonjour,

Il nous faudrait la feuille (avec seulement quelques lignes)

pour voir la configuration

Claude

Désolé j'ai des problèmes de connexion, Voici un un passage

-- 02 Avr 2010, 15:17 --

capture reference ourlook
24exemple.zip (4.99 Ko)

bonjour

j'ai remarqué que les espaces aà combler ne pouvaient pas toujours contenir de nombres entiers si; l'on considere

ta demande. Est-ce genant ? car a l'analyse de la colonne il n'y a que des entiers et la pogression (quand il y en a une ) est n+1

dis nous avec quoi tu veux boucher les trous , nous essaierons de trouver des rustines adaptées

a+

Bonjour à tous,

Sub Concatene()
'Macros par Claude Dubois pour "Basosa" Excel-Pratique le 03/04/10
Dim Lg&, i&, J&, Ct As Byte, A As Byte
Dim t1, x, y, z
    t1 = Time
    Lg = Range("A65536").End(xlUp).Row
    Application.ScreenUpdating = False
    Columns(2).Insert
    Columns(1).Copy Destination:=Columns(2)
For i = 1 To Lg
    If Cells(i + 1, 1) = 0 And Cells(i + 1, 1) <> "" Then
            J = i + 1
            x = Cells(i, 1)
        Do While Cells(J, 1) = 0
            J = J + 1
            Ct = Ct + 1
        Loop
            y = Cells(J, 1)
        '-----ok
        For A = 1 To Ct
            If Ct = 1 Then
                z = WorksheetFunction.Floor(WorksheetFunction.Average(y, x), 0.05)
                Cells(i + A, 2) = z
            Else
                z = (y - x) / (Ct + 1)
               Cells(i + A, 2) = WorksheetFunction.Floor(Cells(i, 1) + (z * A), 0.05)
            End If
        Next A
            i = J - 1
            Ct = 0
    End If
Next i
    'Columns(1).Delete
    Application.ScreenUpdating = True
    MsgBox ("temps macro = " & Format(Time - t1, "hh:mm:ss") & Chr(10) & _
    "Vous pouvez supprimer la colonne A")
End Sub

Tu me diras le temps de traitement pour les 60 000 lignes

Bonne journée

Claude

12basosa-manque.zip (20.02 Ko)
7stats-geny-3.xlsm (166.58 Ko)

Bonjour à tous,

Claude a été le + rapide, bravo!

autre solution et m^me question: quel temps pour 60 000 lignes ?

Sub combler_0()
Dim Derlig As Long, Lig As Long, Cptr As Long
Dim Tps1 As Long, Tps2 As Long, Nbre As Long
Dim lig_e As Long, quote As Long

'initialisations
Derlig = Range("A65536").End(xlUp).Row
Lig = 65536
Application.ScreenUpdating = False
'recherche de la première valeur 0 et suivantes
For Cptr = 1 To Derlig
    Lig = Columns(1).Find(0, Cells(Lig, 1), xlValues, xlWhole).Row
    'compte le nombre de 0 contigus
   Nbre = 0
    While Cells(Lig, 1) = 0
        Nbre = Nbre + 1
        Lig = Lig + 1
    Wend
    ' valeur temps de reprise
    Tps2 = Cells(Lig, 1)
    'remplace les valeurs 0 par fraction proportionnelle aux écarts de temps _
    arrondie à l'unité
    quote = 0
    For lig_e = Lig - Nbre To Lig - 1
        Tps1 = Cells(lig_e - 1, 1)
        Cells(lig_e, 1) = Tps1 + Round((Tps2 - Tps1) / (Nbre - quote + 1), 0)
        quote = quote + 1
    Next
Next
End Sub

la solution la + rapide serait certainement de passer par 1 tableau-array (j'essaierai cet ap-midi(pluie annoncée dans mon coin))

re forum, Salut Michel,

Attention,

dans ton fichier l'arrondi provoque quelques doublons !

Claude

Bonjour a tous merci a vous je suis désolé d'avoir fait le mort mais ma connexion internet ne marché plus, je vas tenter le programmes mais j'avoue ne jamais avoir utiliser de programmation via excel et ne suis donc pas sur d'y arriver, mais en tout cas c énorme, merci merci.

4test-dbsv6.xlsm (147.91 Ko)

re, Claude:

dubois a écrit :

re forum, Salut Michel,

Attention,

dans ton fichier l'arrondi provoque quelques doublons !

Claude

tu as certainement raison mais je ne comprend pas ce que tu veux dire (j'ajoute la valeur de la ligne-1 à chaque coup) ; de toutes façons,pour la méthode de calcul de remplacement du zéro,ta solution avec le calcul de la moyenne me parait plus ingénieuse que mon zinzin, donc...

pour Basosa:

Avec 60000 lignes, une solution par formules compliquées risquerait de rendre ton classeur obèse d'où ces propositions...Tu nous dis si tu as du mal à installer les procédures mais utilises des copies de ton classeur original pour faire des essais!

re Michel,

Regarde doublons en lignes

94 ; 217 ; 493 ; 495

suffit d'arrondir à 1 décimale

Cells(lig_e, 1) = Tps1 + Round((Tps2 - Tps1) / (Nbre - quote + 1), 1)

Claude

Claude:

OK, bien vu, merci

Bonjour a vous, je suis désolé de vous déranger après tout se que vous avez fais mais je ne sais pas du tout comment lancer l'application que vous m'avez envoyé, il me semble qu'il s'agit d'une macro mais je sais pas du tout comment la lancer si vous pouvez m'aider sa serais vraiment chouette.

Merci merci

Bonjour,

code vbe

Clique droit sur le VBAProject de ton fichier et Insertion Module

Et tu copie/colle la macro dans le module que tu as insérer

l'image est un exemple

Claude

OK c'est nickel merci beaucoup, pour le temps consacré.

re,

essaye de nous communiquer le temps de traitement des 60 000 lignes (environ)

Claude

Re, c'est vraiment gênant, mais j'ai encore un problème, j'ai lancé la macro et sa ma enlever les résultats de toutes le cellules et à juste affiché la formule et sa met comme message que la colonne A peut être supprimé.

J'imagine qu'il s'agit un d'un problème d'organisation des cellules sur mon fichier qui fait que la macro la lance sur une colon qui n'est pas la bonne, du cout est ce qu'il faudrait que le fichier soit organisé d'une certaine manière pour appliquer la macro??

Merci et pardon pour le dérangement

re,

Toujours pareil !!

c'est pourquoi au départ je demandais:

Il nous faudrait la feuille (avec seulement quelques lignes)

pour voir la configuration

il faut la structure réelle pour adapter la macro (l'emplacement des en-têtes, ligne et colonnes)

Claude

Bonjour à tous

Pourquoi le post a t il été coché "résolu" ?

Ci dessous proposition par tableau-array testé sur 20000 lignes avec environ 2800 zéros; temps: <1 seconde

Sub partablo()
Dim derlig As Long, cptr_x As Long, cptr_0 As Long, pas As Single
Dim tablo

derlig = Range("A65536").End(xlUp).Row
tablo = Range("A1:A" & derlig)

 t1 = Time

Lig = 1
Do Until Lig = derlig
    cptr_x = 0
    cptr_0 = 0

    While tablo(Lig, 1) <> 0
        If Lig + 1 = derlig Then Exit Do
        Lig = Lig + 1
    Wend
    cptr_x = Lig

    While tablo(Lig, 1) = 0
        cptr_0 = cptr_0 + 1
        Lig = Lig + 1
    Wend

    pas = Round((tablo(Lig, 1) - tablo(cptr_x - 1, 1)) / (cptr_0 + 1), 1)
    While cptr_x <= Lig - 1
        tablo(cptr_x, 1) = tablo(cptr_x - 1, 1) + pas
        cptr_x = cptr_x + 1
    Wend
Loop

Application.ScreenUpdating = False
Range("A1:A" & derlig) = tablo

MsgBox "temps macro = " & Format(Time - t1, "hh:mm:ss")
End Sub
----------
Sub maquette()
Application.ScreenUpdating = False
For Lig = 1 To 20000
Cells(Lig, 1) = 190 + Lig
Next
Randomize
For Cptr = 1 To 3000
    Nbre = Int(Rnd * 20000) + 1
    Cells(Nbre, 1) = 0
Next
End Sub

ci joint maquette: attention l'initialisation (sub maquette) est longue du fait de la fonction aléatoire

merci de me signaler d'éventuels bugs et/ou améliorations

bonjour j'ai préparer le tableau sur une seul colonne avec donc les 60000 données, tout a bien fonctionné bien qu'il y ai eu un message d'erreur à la ligne 13 mais pourtant tout c'est bien fait, le temps est d'environ 40s.

Merci à vous c parfais

Rechercher des sujets similaires à "colpleter information manquantes"