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