0
votes

Deux boîtes de combo à charge

de

7 commentaires

Note latérale: Les noms de variables descriptifs font du débogage (ou de la révision du code) beaucoup plus facilement - les noms tels que X, Y, C, T1, etc. sont difficiles à suivre car ils ne veulent rien dire (à moins que vous ne les aiesées!).


@Samueleverson Désolé, je suis nouveau à cela et j'étais surtout copier et coller du code du net. Mais va essayer de faire cela à l'avenir.


En outre, l'indentation de votre code rend beaucoup plus facile à suivre


Mettez votre code dans l'événement de sortie non dans l'événement de changement. Ensuite, c'est un code très similaire à ce que vous avez déjà. Votre code existant vérifie si cela peut correspondre à C .... Si c est maintenant ComboBox2.Value, vous êtes à mi-chemin là-bas


@Tinbum je vais garder ça à l'esprit. En outre, j'ai essayé de faire ça. Pas sûr où je me suis trompé cependant.


Si vous postez ce code aussi, nous pouvons tous regarder. Dans la 1ère Combobox, vous trouvez des allumettes simples (si x = 1 ...), dans le code de sortie, vous trouvez plusieurs correspondances (si x> 0 ...) La gamme de comptes est également différente.


@Zainvontay Pas besoin d'être désolé! Nous avons tous appris de temps en temps!


3 Réponses :


0
votes

Vous pouvez utiliser un dictionnaire pour obtenir vos valeurs uniques et renseigner cela sur votre initialiser code> sous code>. En faisant cela un de la variable code> dans la portée du userform code> vous permettra de l'utiliser ultérieurement sur l'événement code> modifier code> pour obtenir votre liste Valeurs

Option Explicit
Private Uniques As Object
Private Sub UserForm_Initialize()
    Dim c As Range, InputRng As Range
    Dim tmp As Variant
    Dim k As String

    Set Uniques = CreateObject("Scripting.Dictionary")
    With Worksheets("w1")
        Set InputRng = .Range(.Cells(2, 2), .Cells(.Cells(.Rows.Count, 2).End(xlUp).Row, 2))

        For Each c In InputRng
            k = c.Value2
            If Uniques.exists(k) Then
                tmp = Uniques(k)
                ReDim Preserve tmp(LBound(tmp) To UBound(tmp) + 1)
                tmp(UBound(tmp)) = c.Offset(0, 1).Value2
                Uniques(k) = tmp
            Else
                ReDim tmp(0)
                tmp(0) = c.Offset(0, 1).Value2
                Uniques.Add Key:=k, Item:=tmp
            End If
        Next c

        Cmb1.List = Uniques.keys
    End With

End Sub
Private Sub Cmb1_Change()
    Cmb2.ListIndex = -1
    If Cmb1.ListIndex > -1 Then
        Cmb2.List = Uniques(Cmb1.Value)
    End If
End Sub


3 commentaires

Merci pour l'aide! Cependant, j'essaie d'éviter d'utiliser le dictionnaire pour diverses raisons.


@Zainvontay Pourquoi?


J'essayais d'apprendre à utiliser le dictionnaire depuis la semaine dernière et je ne pouvais pas le comprendre du tout. Mais merci pour l'aide!



1
votes

Ce sont les os d'une solution pour le code d'événement de sortie. Il devrait être correct pour des centaines de lignes, mais peut être lent pour des milliers de lignes, vous devez également vous entraîner de faire de l'entraînement des 2 gammes - je les ai assignées arbitrairement à des gammes fixes.

sur le côté plus, il devrait être simple à suivre P>

Dim Rng1 As Range, Rng2 As Range
Dim xCel As Range, List2 As String

Rng1 = Range("A10:A20") ' whatever Range covers your Col1 Data
Rng2 = Range("B10:B20") ' whatever Range covers your Col2 Data

List2 = ""
For Each xCel In Rng2.Cells
   If xCel.Offset(0, -1).Value = Combobox1.Value Then
      ' Add this Value to a String using VbCrLf as a Separator
      List2 = IIf(List2 = "", "", List2 & vbCrLf) & CStr(xCel.Value)
   End If
Next xCel
' Split the String into an Array of Values for ComboBox2
ComboBox2.List = Split(List2, vbCrLf)


2 commentaires

Merci pour l'aide! J'essaie d'utiliser votre code et j'ai réussi à trouver un moyen. Aimerait vos pensées dessus.


Postez votre nouveau code comme addendum à votre question, puis envoyez-moi un message, heureux de le regarder.



0
votes
Private Sub Cmb1_Change()
Dim wslk As Worksheet
Set wslk = Worksheets("w1")

Dim i As Integer
    Cmb2.Clear

For i = 2 To wslk.Range("B" & Application.Rows.Count).End(xlUp).row
    If wslk.Range("B" & i).Value = Cmb1.Value Then
    Cmb2.AddItem wslk.Range("C" & i)
End If

0 commentaires