Nbr col dépassé ListBox !

[herve62]

Bonjour
J'essaye de faire un compile de composants par année et mois , ex sur 2017 je récapitule les composants en total par mois , mais à M=10 > erreur ? ( j'avais M=11 donc j'ai testé avec M-1 et c'est 10 la limite)
Quelle solution ? et si possible en plus ! je bute si un même composant est discontinu dans la liste ex : CI , CI , cable , CI

 

[JHA]

Bonjour à tous,

Hors sujet VBA mais un TCD ne te convient pas?

JHA

 

[cp4]

Bonsoir,

La solution ici

 

[job75]

Bonsoir herve62, JHA, cp4,

Oui la limite de 10 colonnes n'existe que si l'on utilise la méthode AddItem, pas avec la méthode List.

Voyez le fichier joint et le code de l'UserForm :

Private Sub ComboBox1_Change()
ListBox1.Clear 'RAZ
If ComboBox1.ListIndex = -1 Then ComboBox1 = "": Exit Sub
Dim an%, tablo, liste(), d As Object, i&, x$, n&, lig&, col As Byte
an = Val(ComboBox1)
tablo = Feuil1.[A5].CurrentRegion.Resize(, 4)
Set d = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
For i = 2 To UBound(tablo)
    If Year(tablo(i, 1)) = an Then
        x = tablo(i, 2)
        If Not d.exists(x) Then
            n = n + 1
            d(x) = n
            ReDim Preserve liste(1 To 13, 1 To n)
            liste(1, n) = x
        End If
        lig = d(x): col = 1 + Month(tablo(i, 1))
        liste(col, lig) = liste(col, lig) + tablo(i, 4)
    End If
Next
If n Then ListBox1.List = Application.Transpose(liste) 'Transpose est limitée à 65536 lignes
End Sub

Private Sub UserForm_initialize()
Dim cw$, i As Byte
ComboBox1.List = Feuil2.[A1].CurrentRegion.Value
'---largeurs des colonnes de la ListBox et des Labels---
cw = 40
Label13.Width = 40
Label13.Left = 12
For i = 1 To 12
    cw = cw & ";" & 26
    Me("Label" & i).Width = 26
    Me("Label" & i).Left = 52 + 26 * (i - 1)
Next
ListBox1.ColumnWidths = cw
End Sub

A+

 

[herve62]

Bonsoir
Merci à vous (JHA,Cp4, Job)
Sinon j'avais poursuivi mes recherches et forcément tombé sur notre JB avec un exemple via tableau à 2 dim.
pas si simple que cela
Il faut maintenant digérer tout ça !
@JHA : je ne maîtrise pas trop les TCD et je ne trouve pas que les résultats soient apparents au 1er coup d'oeil

 

[job75]

Bonjour le forum,

Dans ce problème un UserForm n'est pas d'un grand intérêt.

Il vaut mieux avoir les résultats dans la feuille de calcul que l'on met en forme comme on veut :

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [G3]) Is Nothing Then Exit Sub
Dim an%, tablo, liste(), d As Object, i&, x$, n&, lig&, col As Byte
an = [G3]
If an > 0 Then
    tablo = [A5].CurrentRegion.Resize(, 4)
    Set d = CreateObject("Scripting.Dictionary")
    d.CompareMode = vbTextCompare 'la casse est ignorée
    For i = 2 To UBound(tablo)
        If Year(tablo(i, 1)) = an Then
            x = tablo(i, 2)
            If Not d.exists(x) Then
                n = n + 1
                d(x) = n
                ReDim Preserve liste(1 To 13, 1 To n)
                liste(1, n) = x
            End If
            lig = d(x): col = 1 + Month(tablo(i, 1))
            liste(col, lig) = liste(col, lig) + tablo(i, 4)
        End If
    Next
End If
'---restitution---
With [F6] '1ère cellule de destination, à adapter
    If n Then
        .Resize(n, 13) = Application.Transpose(liste) 'Transpose est limitée à 65536 lignes
        .Resize(n, 13).Interior.ColorIndex = 36 'jaune clair
        .Resize(n, 13).Borders.Weight = xlHairline 'bordures
    End If
    .Offset(n).Resize(Rows.Count - n - .Row + 1, 13).Delete xlUp 'RAZ sous le tableau
End With
End Sub

Fichier (2).

A+

 

[herve62]

Bonjour
En fait j'avais déjà un exemple plus simple (3 col et juste info à afficher) ensuite en cliquant je prenais la ligne
d'infos pour aller coller dans un formulaire à plusieurs endroits
Là idem on peut choisir la ligne désirée

 

[job75]

Re,

Pour le fun voici ci-joint une solution par formules qui présente un intérêt seulement si le tableau source est petit.

J'ai testé avec des données sur toute la plage A6: D1000 et des formules tirées sur F6:R1000.

La durée du recalcul varie chez moi de 35 à 140 secondes suivant le nombre de doublons... C'est rédhibitoire.

A+