BUG.....Trie/Date un ensemble de cellules [Résolu]

[stef371967]

Bonsoir je revient a vous car la je BUG ..................

j'ai édité presque seul ( Merci Gorfael ) la macro UserForm au passage
un petit sondage sur mon travail

Voila je me lance effectuer un trie par date en ordre croissant
un ensemble de cellule automatique ou par bouton
sur ma feuil 1

Merci d'avance pour tous
PS : voir fichier joint pour plus de détail

 

[stef371967]

Re : BUG.....Trie/Date un ensemble de cellules

Merci
je joint un nouveaux fichier modifier en Test 6 plus haut
Car la je sèche pour la suite .
Avec toujours les explications
Merci a vous d'avence
Stef..............

 

[Guest]

Re : BUG.....Trie/Date un ensemble de cellules

Bonjour,

Plutôt que de trier après coup, je te propose d'insérer la fiche au bon endroit sur validation du userForm.

Private Sub CommandButton1_Click()
    Dim Cel As Range, Plage As Range
    Dim H As Long, lig As Long
    Dim i As Long
    
'Protection de la feuille
    ActiveSheet.Unprotect
    
'Calcul de la Hauteur d'un enregistrement
    H = Range("A33").MergeArea.Rows.Count
 
    'Calcul de la dernière ligne
    lig = Cells(Rows.Count, "A").End(xlUp).Row - 11
 
    Do While lig > 33
        If IsNumeric(Cells(lig, "A")) Then
            'Test de date
            If Cells(lig + 2, 3).Value > DateValue(TextBox3) And Cells(lig - 3, 3) < DateValue(TextBox3) Then Exit Do
        End If
        lig = lig - H
    Loop
    
 'Copie de l'enregistement
    [A33:N37].Copy
    Range("A" & lig).Insert Shift:=xlDown
    'Formatage des ligne
    Range("A" & lig).MergeArea.Rows.RowHeight = [A33].RowHeight
   
 'RAZ
    Range("A" & lig).MergeArea.ClearContents
    Range("C" & lig).MergeArea.ClearContents
    Range("C" & lig + 1).MergeArea.ClearContents
    Range("C" & lig + 2).MergeArea.ClearContents
    Range("C" & lig + 3).MergeArea.ClearContents
    Range("K" & lig + 1).MergeArea.ClearContents
    Range("G" & lig + 2).MergeArea.ClearContents
    Range("N" & lig + 1).MergeArea.ClearContents
    
'Renvoi texte dans cellule
    Range("C" & lig) = TextBox1
    Range("C" & lig + 1) = TextBox2
    Range("C" & lig + 2) = DateValue(TextBox3)
    Range("G" & lig + 2) = TextBox4
    Range("C" & lig + 3) = TextBox5
    Range("K" & lig + 1) = ComboBox1
    Range("N" & lig + 1) = ComboBox2
       Range("K" & lig + 9).MergeArea.Value = Range("A" & lig).MergeArea.Value
    Range("C" & lig).Activate
  
 'Numéro d'ordre 
    For i = 0 To WorksheetFunction.Max(Columns(1))
        lig = 33 + (H * i)
        Range("A" & lig) = i + 1
    Next
    
 'Protection de la feuille
    ActiveSheet.Protect
    'Ferme usrform
    Unload Me
End Sub

Bonne soirée

 

[stef371967]

Re : BUG.....Trie/Date un ensemble de cellules

Merci mais pas de trie en ordre croissant
bon je cherche aussi de mon cote
Stef

 

[pierrejean]

Re : BUG.....Trie/Date un ensemble de cellules

Re

Avec tri par le bouton
NB: la macro tridate pourra eventuellement etre appelée apres un enregistrement

 

[Guest]

Re : BUG.....Trie/Date un ensemble de cellules

Bonjour,
Hello Pierre-Jean

Merci mais pas de trie en ordre croissant
bon je cherche aussi de mon cote

Dans les explications contenues dans le classeur 'Test.xls':

3* Avec un trie croissant par date en fonction des enregistrements a fur et a mesure sur la feuil 1 ou PAR LE BOUTON

Y'a comme qui dirait un Spchournts!

A+

 

[stef371967]

Re : BUG.....Trie/Date un ensemble de cellules

Merci pierrejean ; Hasco pour votre aide tres bon boulot
ma demande clôture