XL 2019 Recopier mes feuilles dans mon USF

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

Phil Du59

XLDnaute Nouveau
Bonjour à tous
Je reviens vers vous pour améliorer mon tableau afin d’avoir une meilleure visibilité et de regrouper les données de mes feuilles sur mon USF , si tout est possible bien sur .
Pour entrer mes données je passe par NEW QSO

1° Dans la Listbox 1 , recopier la ligne de B2 à H2 de le feuille LOG .

2° Dans la Listbox 2 (le grand cadre) , recopier les entrées des colonnes B C D E F G et H de façon à voir toujours le dernier entré visible en bas , donc avec la liste qui monte au fur et à mesure (si c’est possible)

3° Dans la Listbox 3 (QSO N°) , recopier la case A2 de la feuille LOG

4° Dans la Listbox 4 (DXCC WORKED) , recopier la case L1 de la feuille STATS

5° Dans la Listbox 5 (celle en bas) , recopier de H2 à Q31 de la feuille STATS (par ordre croissant si possible)

Je pense n’avoir rien oublié dans mes demandes , en tout cas n’hésitez pas à demander si besoin , en fait tout ce que je rentre dans la partie haute de mon USF serait visible dans les ListBox pour avoir un aperçu global .

Par avance Merci , Philippe
 

Pièces jointes

Solution
Oui sans les doublons merci
Avec ce code il n'y a plus de doublon dans le 2ème tableau de la feuille STATS :
VB:
Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L&, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    If n = 0 Then Exit Sub
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    Cells(L, C) = Tablo2(0): C = C + 1
    For i = 1 To UBound(Tablo2)
        If...
Bonjour le forum,

Utilisez ce code :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If UserForms.Count Then CommandButton1_Click 'rouvre l'UserForm pour le mettre à jour
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, a, i&
Set plage = Range("B3:H" & Cells(Cells.Rows.Count, "B").End(xlUp).Row)
With UserForm1.ListBox1
    .ColumnCount = plage.Columns.Count
    .List = plage.Rows(IIf(plage.Row = 2, 1, 0)).Value
End With
With UserForm1.ListBox2
    .ColumnCount = plage.Columns.Count
    a = plage
    For i = 1 To UBound(a): a(i, 5) = Format(a(i, 5), "hh:mm"): Next i
    .List = a
    If plage.Row = 2 Then .Clear 'si le tableau est vide
End With
UserForm1.ListBox3.AddItem [A2]
UserForm1.ListBox5.AddItem Sheets("STATS").[L1]
With Sheets("STATS").[H2:Q31]
    .Parent.Worksheet_Activate 'exécute le tri
    UserForm1.ListBox4.ColumnCount = .Columns.Count
    UserForm1.ListBox4.ColumnWidths = Application.Rept((UserForm1.ListBox4.Width - 15) \ .Columns.Count & ";", .Columns.Count)
    UserForm1.ListBox4.List = .Value
End With
UserForm1.Show 0 'ouverture en non modal
End Sub
La macro Quick sort est utilisée pour trier le tableau de la feuille STATS.

A+
Bonsoir Job, j'ai relevé des bugs sur le USF
1 En prenant le tableau tel que tu l'as fais , si je veux ajouter des autres personnes , il recommence en haut du tableau et écrase les autres 1 par 1 .
2 Si j'efface le tableau et que je commence à entrer les personnes j'ai un message d'erreur Visual Basic "Erreur d'exécution '13' incompatibilité de type " .
3 Les compteurs pour QSO et DXCC ne vont pas plus loin que 13 sauf si je quitte le USF et ouvre à nouveau la MàJ se fait .
Voilà ce que j'ai trouvé, D'avance merci pour ton aide .
 
J'ai revu le code, testez-le :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If UserForms.Count Then CommandButton1_Click 'rouvre l'UserForm pour le mettre à jour
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, a, i&
Set plage = Range("B3:H" & Cells(Cells.Rows.Count, "B").End(xlUp).Row)
With UserForm1.ListBox1
    .ColumnCount = plage.Columns.Count
    .List = plage.Rows(IIf(plage.Row = 2, 1, 0)).Value
End With
With UserForm1.ListBox2
    .ColumnCount = plage.Columns.Count
    a = plage
    For i = 1 To UBound(a): a(i, 5) = Format(a(i, 5), "hh:mm"): Next i
    .List = a
    If plage.Row = 2 Then .Clear 'si le tableau est vide
End With
With UserForm1.ListBox3: .Clear: .AddItem [A2]: End With
With Sheets("STATS").[H2:Q31]
    Application.ScreenUpdating = False: .Parent.Activate: Me.Activate: Application.ScreenUpdating = True 'exécute le tri
    UserForm1.ListBox4.ColumnCount = .Columns.Count
    UserForm1.ListBox4.ColumnWidths = Application.Rept((UserForm1.ListBox4.Width - 10) \ .Columns.Count & ";", .Columns.Count)
    If Application.Count(.Columns(1)) Then UserForm1.ListBox4.List = .Resize(Application.Count(.Columns(1))).Value
End With
With UserForm1.ListBox5: .Clear: .AddItem Sheets("STATS").[L1]: End With
UserForm1.Show 0 'ouverture en non modal
End Sub
Attention, vérifiez que le calcul est bien en Automatique (pour la mise à jour de A2).
 

Pièces jointes

J'ai revu le code, testez-le :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If UserForms.Count Then CommandButton1_Click 'rouvre l'UserForm pour le mettre à jour
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, a, i&
Set plage = Range("B3:H" & Cells(Cells.Rows.Count, "B").End(xlUp).Row)
With UserForm1.ListBox1
    .ColumnCount = plage.Columns.Count
    .List = plage.Rows(IIf(plage.Row = 2, 1, 0)).Value
End With
With UserForm1.ListBox2
    .ColumnCount = plage.Columns.Count
    a = plage
    For i = 1 To UBound(a): a(i, 5) = Format(a(i, 5), "hh:mm"): Next i
    .List = a
    If plage.Row = 2 Then .Clear 'si le tableau est vide
End With
With UserForm1.ListBox3: .Clear: .AddItem [A2]: End With
With Sheets("STATS").[H2:Q31]
    Application.ScreenUpdating = False: .Parent.Activate: Me.Activate: Application.ScreenUpdating = True 'exécute le tri
    UserForm1.ListBox4.ColumnCount = .Columns.Count
    UserForm1.ListBox4.ColumnWidths = Application.Rept((UserForm1.ListBox4.Width - 10) \ .Columns.Count & ";", .Columns.Count)
    If Application.Count(.Columns(1)) Then UserForm1.ListBox4.List = .Resize(Application.Count(.Columns(1))).Value
End With
With UserForm1.ListBox5: .Clear: .AddItem Sheets("STATS").[L1]: End With
UserForm1.Show 0 'ouverture en non modal
End Sub
Attention, vérifiez que le calcul est bien en Automatique (pour la mise à jour de A2).
J'ai revu le code, testez-le :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If UserForms.Count Then CommandButton1_Click 'rouvre l'UserForm pour le mettre à jour
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, a, i&
Set plage = Range("B3:H" & Cells(Cells.Rows.Count, "B").End(xlUp).Row)
With UserForm1.ListBox1
    .ColumnCount = plage.Columns.Count
    .List = plage.Rows(IIf(plage.Row = 2, 1, 0)).Value
End With
With UserForm1.ListBox2
    .ColumnCount = plage.Columns.Count
    a = plage
    For i = 1 To UBound(a): a(i, 5) = Format(a(i, 5), "hh:mm"): Next i
    .List = a
    If plage.Row = 2 Then .Clear 'si le tableau est vide
End With
With UserForm1.ListBox3: .Clear: .AddItem [A2]: End With
With Sheets("STATS").[H2:Q31]
    Application.ScreenUpdating = False: .Parent.Activate: Me.Activate: Application.ScreenUpdating = True 'exécute le tri
    UserForm1.ListBox4.ColumnCount = .Columns.Count
    UserForm1.ListBox4.ColumnWidths = Application.Rept((UserForm1.ListBox4.Width - 10) \ .Columns.Count & ";", .Columns.Count)
    If Application.Count(.Columns(1)) Then UserForm1.ListBox4.List = .Resize(Application.Count(.Columns(1))).Value
End With
With UserForm1.ListBox5: .Clear: .AddItem Sheets("STATS").[L1]: End With
UserForm1.Show 0 'ouverture en non modal
End Sub
Attention, vérifiez que le calcul est bien en Automatique (pour la mise à jour de A2).
Pour l'instant c'est ok , je reteste demain avec le changement de date si rien ne change , merci bonne soirée Job
 
Ah mais si l'on entre "XXX" en C3 ça ne va pas, il faut rechercher la dernière ligne :
VB:
Private Sub Worksheet_Change(ByVal Target As Range)
If UserForms.Count Then CommandButton1_Click 'rouvre l'UserForm pour le mettre à jour
End Sub

Private Sub CommandButton1_Click()
Dim plage As Range, a, i&, h&
Set plage = Range("B3:H" & Cells(Cells.Rows.Count, "B").End(xlUp).Row)
With UserForm1.ListBox1
    .ColumnCount = plage.Columns.Count
    .List = plage.Rows(IIf(plage.Row = 2, 1, 0)).Value
End With
With UserForm1.ListBox2
    .ColumnCount = plage.Columns.Count
    a = plage
    For i = 1 To UBound(a): a(i, 5) = Format(a(i, 5), "hh:mm"): Next i
    .List = a
    If plage.Row = 2 Then .Clear 'si le tableau est vide
End With
With UserForm1.ListBox3: .Clear: .AddItem [A2]: End With
With Sheets("STATS").[H2:Q31]
    Application.ScreenUpdating = False: .Parent.Activate: Me.Activate: Application.ScreenUpdating = True 'exécute le tri
    UserForm1.ListBox4.ColumnCount = .Columns.Count
    UserForm1.ListBox4.ColumnWidths = Application.Rept((UserForm1.ListBox4.Width - 10) \ .Columns.Count & ";", .Columns.Count)
    For i = 1 To .Rows.Count: h = IIf(Application.Count(.Rows(i)), i, h): Next i
    If h Then UserForm1.ListBox4.List = .Resize(h).Value
End With
With UserForm1.ListBox5: .Clear: .AddItem Sheets("STATS").[L1]: End With
UserForm1.Show 0 'ouverture en non modal
End Sub
 

Pièces jointes

Bonjour Job et à tous
Je vous joins le test que j'ai fais pour mieux voir le bug dans la partie STATS, sur le USF quand on écrit dans la case QRZ par exemple 12FFF , tant que le 12 n'est pas déjà enregistré ça fonctionne mais si on écrit par exemple 12XXX on voit bien que ça se décale dans les cases et la recopie sur le USF n'est pas entière et le compteur fonctionne bien , je vous laisse voir le fichier .
 

Pièces jointes

Bonjour à tous,
@Phil vous chercher à faire quoi avec ce formulaire ? Si c'est juste ajouter des lignes au tableau de la feuille Log ce n'est pas très compliqué.
Maintenant à quoi servent les deux tableaux de la feuille Stats et comment voulez-vous les gérer ?
Je l'ai dis à maintes fois, incrémenter un index dans un tableau à l'aide d'une formule ici "=LIGNE() - 2" ce n'est pas une bonne idée. En cas de suppression de ligne de votre tableau, tout va partir à vau-l'eau.
On peut vous aider mais vous devez donner une description complète et cohérente. D'après ce que j'ai compris :
  • Un clic sur le tableau de la feuille log doit pouvoir permettre d'éditer la ligne qui a été cliquée.
  • Quelle liaison y a t-il entre une ligne du tableau de la feuille LOG et les lignes du tableau de la feuille STATS qui contient des chiffres ?
 
Bonjour à tous,
@Phil vous chercher à faire quoi avec ce formulaire ? Si c'est juste ajouter des lignes au tableau de la feuille Log ce n'est pas très compliqué.
Maintenant à quoi servent les deux tableaux de la feuille Stats et comment voulez-vous les gérer ?
Je l'ai dis à maintes fois, incrémenter un index dans un tableau à l'aide d'une formule ici "=LIGNE() - 2" ce n'est pas une bonne idée. En cas de suppression de ligne de votre tableau, tout va partir à vau-l'eau.
On peut vous aider mais vous devez donner une description complète et cohérente. D'après ce que j'ai compris :
  • Un clic sur le tableau de la feuille log doit pouvoir permettre d'éditer la ligne qui a été cliquée.
  • Quelle liaison y a t-il entre une ligne du tableau de la feuille LOG et les lignes du tableau de la feuille STATS qui contient des chiffres ?
Bonjour Valtrase
Mon tableau va me servir pour la radiocommunication (style radio amateur) toute personnes qui me contacte sera enregistré dans mon tableau via le USF QSO et chacun a un indicatif qui commence par un numéro , lettres et numéro " 14 WW 123" chaque pays possède un numéro différent comme décrit dans STATS tableau de gauche , 14 = FRANCE et donc chaque pays contacté est repris dans le tableau de droite pour les comptabiliser .
Les lignes dans mon tableau ne seront pas supprimé car elles sont gérer avec les doublons donc si 14WW123 est déjà enregistré il ne pourra y être une seconde fois .
Donc mon tableau me sert à gérer tout mes contacts radio et de passer par un USF c'est beaucoup mieux pour éviter des erreurs car je ne serais pas le seul à l'utiliser .
Voilà si vous avez d'autres questions , je suis là .
 
La macro Worksheet_Activate dans la feuille STATS n'est pas de moi mais je veux bien la modifier :
VB:
Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L%, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    For i = 0 To UBound(Tablo2)
        Cells(L, C) = Tablo2(i)
        C = C + 1
        If C = 18 Then C = 8: L = L + 1
    Next i
End Sub
Dans la liste de nombres ainsi créée il peut y avoir des doublons, dites-nous si vous voulez les éviter.
 

Pièces jointes

@Phil vous chercher à faire quoi avec ce formulaire ?
Tu peux demander à ce Phil s'il a déjà essayé d'utiliser des TS pour les tableaux de ses feuilles, et le RowSource pour sa ListBox2, stp ?

Tu as bien sûr raison : mettre une formule qui calcule le rang d'une ligne du tableau ne semble pas très utile car en cas de simple tri, l'ordre de ces rangs reste inchangés dans leur colonne alors que les autres lignes du tableau ne sont plus dans le même ordre, donc à un rang ne correspondent plus les mêmes données.
En revanche, ce qui serait peut-être plus utile, ce serait le rang de création de la ligne qui resterait donc attaché à ses données. Cela permettrait de trier le tableau selon la colonne voulue (par exemple "QRZ"), puis de revenir à l'ordre initial.
 
Dernière édition:
Tu peux demander à ce Phil s'il a déjà essayé d'utiliser des TS pour les tableaux de ses feuilles, et le RowSource pour sa ListBox2, stp ?
Bonjour , mes connaissances sont de zéro niveau codage je n'ai pas les compétences , je sais faire un tableau Excel avec quelques modifs , j'ai beau regarder les codes qui sont ajouter à mon tableau au fur et à mesure mais j'en suis loin , très loin de tout comprendre , donc les TS et Rowsource j'ai bien vu ce dernier dans le USF coté gauche mais de là à savoir à quoi ça correspond , je n'ai pas les bases mais cela m'aurais bien plu , merci de votre compréhension .
 
Bonjour , mes connaissances sont de zéro niveau codage je n'ai pas les compétences , je sais faire un tableau Excel avec quelques modifs , j'ai beau regarder les codes qui sont ajouter à mon tableau au fur et à mesure mais j'en suis loin , très loin de tout comprendre , donc les TS et Rowsource j'ai bien vu ce dernier dans le USF coté gauche mais de là à savoir à quoi ça correspond , je n'ai pas les bases mais cela m'aurais bien plu , merci de votre compréhension .
Oui, tu sembles dire que tu es débutant, c'est pour ça que j'avais pensé que ce serait probablement bien pour toi d'utiliser le RowSource d'un TS car ainsi, comme dit précédemment, tu n'as plus rien à programmer pour mettre à jour la ListBox2 (quand tu ouvres ton UserForm, elle est automatiquement à jour par rapport au TS).
Avec ça, tu es sûr que la ListBox affiche la même chose que le TS, et sans rien programmer puisque la source de ta ListBox est le TS.

Mais si ça ne te tente pas et que tu préfères utiliser des macros pour remplir ta ListBox et la tenir à jour (peut-être est-ce dans le but d'apprendre la programmation ?), c'est effectivement aussi une possibilité. 😉
 
La macro Worksheet_Activate dans la feuille STATS n'est pas de moi mais je veux bien la modifier :
VB:
Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L%, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    For i = 0 To UBound(Tablo2)
        Cells(L, C) = Tablo2(i)
        C = C + 1
        If C = 18 Then C = 8: L = L + 1
    Next i
End Sub
Dans la liste de nombres ainsi créée il peut y avoir des doublons, dites-nous si vous voulez les éviter.
Oui sans les doublons merci

Juste une dernière , pour la listbox 2 comment faire pour voir les dernières entrer visible car actuellement on voit les 14 premiers et les autres en dessous avec la barre de défilement , mais j'aurais voulu voir les 14 derniers de manière à ce que j'ai un visuel pour être sur de ne pas avoir fais d'erreur comme ça si erreur je peux le modifier de suite sur la feuille Excel , dites moi juste si possible et je ferais un autre post , encore Merci .
 
Oui sans les doublons merci
Avec ce code il n'y a plus de doublon dans le 2ème tableau de la feuille STATS :
VB:
Private Sub Worksheet_Activate()
    Dim DL&, Tablo, i&, Dxcc, Tablo2(), n&, L&, C%
    [H2:Q41].ClearContents
    DL = Sheets("LOG").[C10000].End(xlUp).Row
    Tablo = Sheets("LOG").Range("C3:D" & DL) 'au moins 2 éléments
    For i = 1 To UBound(Tablo)
        Dxcc = Val(Left(Tablo(i, 1), 3))
        If Trim(Tablo(i, 1)) Like (Dxcc) & "*" Then
            ReDim Preserve Tablo2(n) 'base 0
            Tablo2(n) = Dxcc
            n = n + 1
        End If
    Next i
    If n = 0 Then Exit Sub
    tri Tablo2, 0, UBound(Tablo2)
    L = 2: C = 8
    Cells(L, C) = Tablo2(0): C = C + 1
    For i = 1 To UBound(Tablo2)
        If Tablo2(i) <> Tablo2(i - 1) Then
            Cells(L, C) = Tablo2(i)
            C = C + 1
            If C = 18 Then C = 8: L = L + 1
        End If
    Next i
End Sub
Et pour afficher les 14 dernières lignes de ListBox2 utilisez sa propriété .TopIndex dans le code de la feuille LOG :
VB:
    If plage.Row = 2 Then .Clear Else .TopIndex = .ListCount
 

Pièces jointes

Dernière édition:
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Réponses
3
Affichages
142
Réponses
5
Affichages
506
Retour