Userform con 6 combobox che inserisce valori

Question

Ciao a tutti,

Confido nel vostro aiuto per automatizzare mediante codice Vba quanto vado a spiegare.

Allego una cartella che renderà meglio l'aiuto che vi chiedo. Ho una userform con 6 combobox e un commandbutton che deve inserire i valori nella colonna B del foglio1. le combobox 2, 3, 4, 5 e 6 riporteranno i valori a partire da B3:B7 fino a completare tutti i campi che si vedono e che vengono descritti nella cartella allegata. Solo per la combobox1 invece il valore finirà nella cella B2 e B8 e a seguire il riempimento degli altri campi come descritto nella cartella allegata. La cartella che rende l'idea, la trovate qui. grazie come sempre per l'aiuto che date.

Answer 1

Ciao non avevo inteso che ci si dovesse fermare alla B52 ma che occorresse ripetere l'inserimento in base al numero di voci presenti nelle combobox (e che i dati inseriti fossero solo un esempio parziale).

Comunque prova a riscaricare il file dal precedente link.

Ho modificato così il codice del pulsante:

Private Sub CommandButton1_Click()

Dim iListIndex As Long

Dim iListCount As Long

Dim i As Long, j As Long

Dim iProg1 As Long, iProg2 As Long

Dim iCell As Long

Const iNumeroSetDati As Long = 5

With Me

  With .ComboBox1 

     iListCount = .ListCount 

     iListIndex = .ListIndex + 1 

     If iListIndex > 0 Then 

        For i = iListIndex To iListCount 

           iProg1 = iProg1 + 1 

           If iProg1 > iNumeroSetDati \* 2 Then Exit For 

           Range("B2").Offset(iProg2).Value = .List(i - 1) 

           If iProg1 Mod 2 = 1 Then 

              iProg2 = iProg2 + 6 

           Else 

              iProg2 = iProg2 + 5 

           End If 

        Next i 

        For i = 1 To iListIndex - 1 

           iProg1 = iProg1 + 1 

           If iProg1 > iNumeroSetDati \* 2 Then Exit For 

           Range("B2").Offset(iProg2).Value = .List(i - 1) 

           If iProg1 Mod 2 = 1 Then 

              iProg2 = iProg2 + 6 

           Else 

              iProg2 = iProg2 + 5 

           End If 

        Next i 

     End If 

  End With 

  iCell = 3 

  For j = 2 To 6 

     iProg1 = 0 

     iProg2 = 0 

     With .Controls("ComboBox" & j) 

        iListCount = .ListCount 

        iListIndex = .ListIndex + 1 

           If iListIndex > 0 Then 

              For i = iListIndex To iListCount 

                 iProg2 = iProg2 + 1 

                 If iProg2 > iNumeroSetDati Then Exit For 

                 Range("B" & iCell).Offset(iProg1).Value = .List(i - 1) 

                 iProg1 = iProg1 + 11 

              Next i 

              For i = 1 To iListIndex - 1 

                 iProg2 = iProg2 + 1 

                 If iProg2 > iNumeroSetDati Then Exit For 

                 Range("B" & iCell).Offset(iProg1).Value = .List(i - 1) 

                 iProg1 = iProg1 + 11 

              Next i 

           End If 

     End With 

     iCell = iCell + 1 

  Next j 

End With

End Sub

Vedi se "gira" come da tue attese.

ciao

Answer 2

Ciao Eleuterio,

Grazie per la considerazione, probabilmente non mi sono spiegato bene. Deve compilare tutti i campi fino alla cella B52.

I valori devono essere riportati in successione di quelli riportati nelle varie combobox.

Ho mal interpretato io, anche vedendo la soluzione di casanmaner non avevo compreso la necessità del ciclo, per cui la rivedo in base al tuo nuovo esempio:

Private Sub CommandButton1_Click() 

Dim arrC1, arrC2, arrL(4) 

Dim intP1 As Integer, intP2 As Integer, intP As Integer 

Dim intL As Integer, intC As Integer 

    arrC1 = Array(2, 8, 13, 19, 24, 30, 35, 41, 46, 52) 

    arrC2 = Array(3, 14, 25, 36, 47) 

    With ActiveSheet 

        intL = Me.ComboBox1.ListIndex 

        For intP = 0 To UBound(arrC1) 

            .Cells(arrC1(intP), 2).Value = Me.ComboBox1.List(intL) 

            intL = intL + 1 

            If intL > Me.ComboBox1.ListCount - 1 Then intL = 0 

        Next intP 

        For intC = 2 To 6 

            arrL(intC - 2) = Me.Controls("ComboBox" & intC).ListIndex 

        Next intC 

        For intP = 0 To UBound(arrC2) 

            For intC = 2 To 6 

                .Cells(arrC2(intP) + intC - 2, 2).Value = Me.Controls("ComboBox" & intC).List(arrL(intC - 2)) 

                arrL(intC - 2) = arrL(intC - 2) + 1 

                If arrL(intC - 2) > Me.Controls("ComboBox" & intC).ListCount - 1 Then arrL(intC - 2) = 0 

            Next intC 

        Next intP 

    End With 

End Sub

Ciao e grazie del riscontro.

Answer 3

Ciao Geacs,

prendendo spunto dalla procedura di Eleuterio ho pensato di perfezionare la mia facendo in modo che, in modo distinto per la combobox1 e le altre, vi sia comunque un unico ciclo e non due cicli spezzati (con ripetizioni delle medesime istruzioni).

Ho anche impostato delle costanti che dovrebbero consentire di intervenire in modo più "immediato" nel caso di spostamento dell'intervallo del seti di dati.

Qui trovi il file di esempio: File esempio

Di seguito il codice modificato:

Private Sub CommandButton1_Click()

Dim iListIndex As Long

Dim iListCount As Long

Dim i As Long, j As Long

Dim iProg1 As Long, iProg2 As Long, iProgList As Long

Dim iCell As Long

Const sColonnaSetDati As String = "B"

Const iRigaPartenzaCB1 As Long = 2

Const iRigaPartenzaCB2to6 As Long = 3

Const iNumeroSetDati As Long = 5

With Me

  With .ComboBox1 

     iListCount = .ListCount 

     iListIndex = .ListIndex + 1 

     If iListIndex > 0 Then 

        iProgList = iListIndex 

        For i = 1 To iListCount 

           iProg1 = iProg1 + 1 

           If iProg1 > iNumeroSetDati \* 2 Then Exit For 

           Range(sColonnaSetDati & iRigaPartenzaCB1).Offset(iProg2).Value = .List(iProgList - 1) 

           iProgList = iProgList + 1 

           If iProgList > iListCount Then iProgList = 1 

           If iProg1 Mod 2 = 1 Then 

              iProg2 = iProg2 + 6 

           Else 

              iProg2 = iProg2 + 5 

           End If 

        Next i 

     End If 

  End With 

  iCell = iRigaPartenzaCB2to6 

  For j = 2 To 6 

     iProg1 = 0 

     iProg2 = 0 

     With .Controls("ComboBox" & j) 

        iListCount = .ListCount 

        iListIndex = .ListIndex + 1 

        iProgList = iListIndex 

           If iListIndex > 0 Then 

              For i = 1 To iListCount 

                 iProg2 = iProg2 + 1 

                 If iProg2 > iNumeroSetDati Then Exit For 

                 Range(sColonnaSetDati & iCell).Offset(iProg1).Value = .List(iProgList - 1) 

                 iProgList = iProgList + 1 

                 If iProgList > iListCount Then iProgList = 1 

                 iProg1 = iProg1 + 11 

              Next 

           End If 

     End With 

     iCell = iCell + 1 

  Next j 

End With

End Sub

Vedi tu se ti può essere di ulteriore aiuto e/o spunto per eventuali futuri progetti.

ciao

Answer 4

Ciao se ho inteso quello che è il tuo intento prova a dare un'occhiata al file FileEsempio

Nel modulo dalla UserForm ho inserito una procedura di inizializzazione per caricare i dati (ma poi dovrai verificare tu che dati caricare in ogni userform).

Per il commandbutton ho pensato a questa procedura:

Private Sub CommandButton1_Click()

Dim iListIndex As Long

Dim iListCount As Long

Dim i As Long, j As Long

Dim iProg1 As Long, iProg2 As Long

Dim iCell As Long

With Me

  With .ComboBox1 

     iListCount = .ListCount 

     iListIndex = .ListIndex + 1 

     If iListIndex > 0 Then 

        For i = iListIndex To iListCount 

           iProg1 = iProg1 + 1 

           Range("B2").Offset(iProg2).Value = .List(i - 1) 

           If iProg1 Mod 2 = 1 Then 

              iProg2 = iProg2 + 6 

           Else 

              iProg2 = iProg2 + 5 

           End If 

        Next i 

        For i = 1 To iListIndex - 1 

           iProg1 = iProg1 + 1 

           Range("B2").Offset(iProg2).Value = .List(i - 1) 

           If iProg1 Mod 2 = 1 Then 

              iProg2 = iProg2 + 6 

           Else 

              iProg2 = iProg2 + 5 

           End If 

        Next i 

     End If 

  End With 

  iCell = 3 

  For j = 2 To 6 

     iProg1 = 0 

     With .Controls("ComboBox" & j) 

        iListCount = .ListCount 

        iListIndex = .ListIndex + 1 

           If iListIndex > 0 Then 

              For i = iListIndex To iListCount 

                 Range("B" & iCell).Offset(iProg1).Value = .List(i - 1) 

                 iProg1 = iProg1 + 11 

              Next i 

              For i = 1 To iListIndex - 1 

                 Range("B" & iCell).Offset(iProg1).Value = .List(i - 1) 

                 iProg1 = iProg1 + 11 

              Next i 

           End If 

     End With 

     iCell = iCell + 1 

  Next j 

End With

End Sub

Verifica se i dati vengono riportati come da te desiderato.

ciao

Answer 5

Ciao a tutti,

Confido nel vostro aiuto per automatizzare mediante codice Vba quanto vado a spiegare.

Allego una cartella che renderà meglio l'aiuto che vi chiedo. Ho una userform con 6 combobox e un commandbutton che deve inserire i valori nella colonna B del foglio1. le combobox 2, 3, 4, 5 e 6 riporteranno i valori a partire da B3:B7 fino a completare tutti i campi che si vedono e che vengono descritti nella cartella allegata. Solo per la combobox1 invece il valore finirà nella cella B2 e B8 e a seguire il riempimento degli altri campi come descritto nella cartella allegata. La cartella che rende l'idea, la trovate qui. grazie come sempre per l'aiuto che date.

Un modo semplice:

Private Sub CommandButton1_Click() 

Dim arrC1, arrC2 

Static intP1 As Integer, intP2 As Integer 

    arrC1 = Array(2, 8, 13, 19, 24, 30, 35, 41, 46, 52) 

    arrC2 = Array(3, 14, 25, 36, 47) 

    With ActiveSheet 

        .Cells(arrC1(intP1), 2).Value = Me.ComboBox1.Value 

        .Cells(arrC2(intP2), 2).Value = Me.ComboBox7.Value 

        .Cells(arrC2(intP2) + 1, 2).Value = Me.ComboBox3.Value 

        .Cells(arrC2(intP2) + 2, 2).Value = Me.ComboBox4.Value 

        .Cells(arrC2(intP2) + 3, 2).Value = Me.ComboBox5.Value 

        .Cells(arrC2(intP2) + 4, 2).Value = Me.ComboBox6.Value 

    End With 

    If intP1 > UBound(arrC1) Then 

        intP1 = 0 

    Else 

        intP1 = intP1 + 1 

    End If 

    If intP2 > UBound(arrC2) Then 

        intP2 = 0 

    Else 

        intP2 = intP2 + 1 

    End If 

End Sub

ma attenzione perché la tua combobox2 non esiste, la trovi come 7,

ciao.