Inserire un dato su una cella avendo una userform con due comandi a tendina

Question

Buonasera, il mio file ha una userform per inserire dati. Su questa ho creato un menù a tendina che inserisce il dato sulla cella (ad esempio) H.

Dato che il menù a tendina raccoglie oltre 50 dati, vorrei dividerla in due menu sempre a tendina ma che in entrambi i casi mi inserissero il dato nella casella H.

Esempio:

primo menu a tendina raccoglie elenco ospedali di tutta Italia

secondo menu a tendina raccoglie i reparti di degenza del mio ospedale

vorrei che scegliendo  il dato dal primo menu oppure dal secondo menù venisse inserito nella medesima cella.

Mi occorre per semplificare il processo di inserimento.

Grazie

Fabio

Answer 1

Ciao Fabio,

Ciao Norman Grazie ancora, il codice funziona perfettamente, ho solo un piccolo problema.

Non riesco a collocare gli altri codici nella Userform1. Dove andrebbero di preciso'

Ti spiego perche se li inserisco sul codice riportato sul tasto Inserimento dati, mi da questo errore:

'=========>>

Option Explicit

'--------->>

Private Sub UserForm_Initialize() <----------------- Qui si verifica l'errore evidenziandolo di giallo

    Dim Ctrl As MSForms.Control

    Dim CBox As MSForms.ComboBox

Dim arrElenchi As Variant

Dim rng As Range

Dim i As Long

Dim oName As Name

Const sElenchi As String = "PROVENIENZA,OSPEDPRO," _

& "SESSO,SALA,REPARTOINTERNO"

arrElenchi = Split(sElenchi, ",")

For Each Ctrl In Me.Controls

If TypeName(Ctrl) = "ComboBox" Then

Set CBox = Ctrl

Set oName = ThisWorkbook.Names(arrElenchi(i))

Set rng = oName.RefersToRange

With CBox

.RowSource = vbNullString

.List = SortedUniqueList(rng.Value)

.MatchEntry = fmMatchEntryComplete

End With

i = i + 1

End If

Next Ctrl

End Sub

P.S non capisco perchè mi ha scritto tutto in grassetto pur avendolo deselezionato

Io non riesco a replicare il tuo problema e quindi ti chiederei di farmi sapere il messagio dell'errore.

Nel frattempo, potresti scaricare il mio file di prova Fabio20180408.xls

A me, il mio codice funziona senza problemi.

===

Regards,

Norman

Answer 2

Buongiorno Norman, ringraziando anticipatamente, ti allego il link con l'esempio da te richiesto. La cella da riempire utilizzando i due menu (o il primo menu oppure il secondo). In teoria se clicco sul primo o il secondo mi dovrebbe sostituire il dato già trascritto è la colonna: Ospedali/Reparto.Nel foglio dati la colonna a cui fanno riferimento i menu a tendina sono: Colonna D  e la colonna E

Vorrei chiederti se fosse possibile inserire la ricerca di una parola mentre scrivo nel menu a tendina.

Grazie

Fabio 

https://www.dropbox.com/s/b2ippnqvbbmu0af/REPARTO2.3%202018.xls?dl=0

Answer 3

Ciao Fabio,

Ciao Norman quello che ti volevo chiedere il codice lo devo inserire in un nuovo modulo?

Il codice suggerito da me verrebbe integrato nel modulo di codice della Userform di interesse.

Se tu volessi caricare un esempio del tuo file, con i fogli esistenti e la userform di interesse, potrei effetuare l'integrazione del mio codice io.

===

Regards,

Norman

Answer 4

Ciao Norman quello che ti volevo chiedere il codice lo devo inserire in un nuovo modulo?

Grazie

Fabio

Answer 5

Ciao Fabio,

il mio file ha una userform per inserire dati. Su questa ho creato un menù a tendina che inserisce il dato sulla cella (ad esempio) H.

Dato che il menù a tendina raccoglie oltre 50 dati, vorrei dividerla in due menu sempre a tendina ma che in entrambi i casi mi inserissero il dato nella casella H.

Esempio:

primo menu a tendina raccoglie elenco ospedali di tutta Italia

secondo menu a tendina raccoglie i reparti di degenza del mio ospedale

vorrei che scegliendo  il dato dal primo menu oppure dal secondo menù venisse inserito nella medesima cella.

Mi occorre per semplificare il processo di inserimento.

Prova qualcosa del genere:

'=========>>

Option Explicit

'--------->>

Private Sub UserForm_Initialize()

    Dim WB As Workbook

    Dim SH_Dati As Worksheet

    Dim rngOspedali As Range, rngProvenienza As Range

    Dim arrOspedali As Variant, arrProvenienza As Variant

    Const sFoglioDati As String = "DATI"                    '<<=== Modifica

    Const sIntervallo_Ospedali As String = _

                                                 "OSPEDALI"               '<<=== Modifica

    Const sIntervallo_Provenienza As String = _

                                                  "PROVENIENZA"       '<<=== Modifica

    Set WB = ThisWorkbook

    Set SH_Dati= WB.Sheets(sFoglioDati)

    With SH_Dati

        Set rngOspedali = .Range(sIntervallo_Ospedali)

        Set rngProvenienza = .Range(sIntervallo_Provenienza)

    End With

    arrOspedali = rngOspedali.Value

    arrProvenienza = rngProvenienza.Value

    With Me

        .cbxOSPEDALI.List = arrOspedali

        .cbxPROVENIENZA.List = arrProvenienza

    End With

End Sub

'--------->>

Private Sub cbOspedale_Provienza_Click()

    Dim SH As Worksheet

    Dim aStr As String, bStr As String, sStr As String

    Dim arrOut(1 To 2) As Variant

    Dim numRiga As Long

    Const sPassword As String = "FABIO"

    Const iUltimaRiga As Long = 518                      '<<=== Modifica

    Const sColonna As String = "D"                          '<<=== Modifica

    Set SH = ActiveSheet

    With Me

        arrOut(1) = .cbxOSPEDALI.Value

        arrOut(2) = .cbxPROVENIENZA.Value

        sStr = Join(arrOut, vbNewLine)

    End With

    With SH

        numRiga = .Cells(iUltimaRiga, "A").End(xlUp).Row

        Select Case numRiga

        Case 1

            numRiga = 3

        Case Is < iUltimaRiga

            numRiga = numRiga + 4

        Case Is >= iUltimaRiga

            Call MsgBox( _

                 Prompt:="Non  è stato possibile inserire i dati " _

                         & "SPAZIO A DISPOSIZIONE TERMINATO " _

                         & "CONTATTARE AMMINISTRATORE!", _

                 Buttons:=vbCritical, _

                 Title:="REPORT")

        End Select

        On Error GoTo XIT

        .Unprotect Password:=sPassword

        .Cells(numRiga, sColonna).Value = sStr

        With Me

            .cbxOSPEDALI.ListIndex = -1

            .cbxPROVENIENZA.ListIndex = -1

        End With

XIT:

        .Protect Password:=sPassword

    End With

End Sub

'<<=========

===

Regards,

Norman