apertura di una userform per ricerca dati e inserimento

Question

ciao a tutti e ben trovati,

ho bisogno ancora del vostro aiuto, in un file excel vorrei che, inserendo un diametro nella cella "E6" , in automatico si apra una userform con l'elenco dei relativi raggi  presenti nella tabella del foglio 2 (se possibile senza i doppioni) 

ad esempio se inserisco il diametro 8 si dovrebbe aprire la userform con i relativi raggi (sempre presente nella tabella del foglio 2) e selezionandone uno il valore dovrebbe essere inserito nella cella "c13"

allego il link di un file con l'esempio 

https://we.tl/t-d9f7yYWYin

grazie 1000

Answer 1

Buongiorno Andrea,

Buongiorno Norman e grazie ,funziona tutto come richiesto,volevo solo chiederti un ultima cosa ,ogni tanto nella cella del diametro "e6" devo inserire un valore che non è presente nella tabella ,è possibile fare in modo che in quel caso la Userform non si apra?

grazie 1000

Nel modulo di codice standard, incolla

'========>>

Option Explicit

Public Rng_Diametro As Range

Public Rng_Raggio As Range

Public Const sTabella As String = "B4:C17"             '<<=== Modifica

Nel modulo di codice del foglio Foglio1, sostituisci il codice con la seguente versione:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim SH2 As Worksheet

    Dim rngTabella As Range

    Dim Res As Variant

    Const sCella_Diametro As String = "E6"

    Const sCella_Raggio As String = "C13"

    Set Rng_Diametro = Intersect(Me.Range(sCella_Diametro), Target)

    If Not Rng_Diametro Is Nothing Then

        Set SH2 = ThisWorkbook.Sheets("Foglio2")

        Set rngTabella = SH2.Range(sTabella)

        Set Rng_Raggio = Me.Range(sCella_Raggio)

        Res = Application.Match(Rng_Diametro.Value, rngTabella.Columns(1), 0)

        If Not IsError(Res) Then

            UserForm1.Show False

        Else

            Rng_Raggio.ClearContents

        End If

    End If

End Sub

'<<========

Ho aggiornato il mio file di prova  Andrea20200604.xlsm

===

Regards,

Norman

Answer 2

Ciao Andrea,

ciao Norman e grazie per l'aiuto, queste sono piccole cose che però nel mio lavoro mi fanno risparmiare del tempo...

grazie e buona giornata

Ti ringrazio per il cortese riscontro.

Alla prossima.

===

Regards,

Norman

Answer 3

ciao Norman e grazie per l'aiuto, queste sono piccole cose che però nel mio lavoro mi fanno risparmiare del tempo...

grazie e buona giornata

Answer 4

Buongiorno Norman e grazie ,funziona tutto come richiesto,volevo solo chiederti un ultima cosa ,ogni tanto nella cella del diametro "e6" devo inserire un valore che non è presente nella tabella ,è possibile fare in modo che in quel caso la Userform non si apra?

grazie 1000

Answer 5

Ciao Andrea,

ho bisogno ancora del vostro aiuto, in un file excel vorrei che, inserendo un diametro nella cella "E6" , in automatico si apra una userform con l'elenco dei relativi raggi  presenti nella tabella del foglio 2 (se possibile senza i doppioni) 

ad esempio se inserisco il diametro 8 si dovrebbe aprire la userform con i relativi raggi (sempre presente nella tabella del foglio 2) e selezionandone uno il valore dovrebbe essere inserito nella cella "c13"

allego il link di un file con l'esempio 

https://we.tl/t-d9f7yYWYin

• Fai clic dx sulla linguetta del foglio Foglio1
• Seleziona l'opzione Visualizza Codice dal **** menu contestuale risultante
• Incolla il seguente codice:

'========>>

Option Explicit

'-------->>

Private Sub Worksheet_Change(ByVal Target As Range) 

    Const sCella_Diametro As String = "E6"

    Const sCella_Raggio As String = "C13"

    Set Rng_Diametro = Intersect(Me.Range(sCella_Diametro), Target)

    If Not Rng_Diametro Is Nothing Then

        Set Rng_Raggio = Me.Range(sCella_Raggio)

        UserForm1.Show False

    End If

End Sub

'<<========

• Alt+F11 per aprire l'editor di VBA
• Alt+IM per inserire un nuovo modulo di codice
• Nel nuovo modulo vuoto, incolla il seguente codice:

'========>>

Option Explicit

Public Rng_Diametro As Range

Public Rng_Raggio As Range

Crea una Userform che comprende un controllo ComboBox e un controllo Commandutton. Nel modulo di codice della Userform, incolla il seguente codice

'========>>

Option Explicit

Priivate Sub UserForm_Initialize()

    Dim SH1 As Worksheet, SH2  As Worksheet

    Dim rngTabella As Range, rCell As Range

    Dim dDiametro As Variant, dRaggio As Double

    Dim oDic As Object

    Dim arrKeys As Variant

    Dim i As Long, j As Long

    Const sTabella As String = "B4:C17"             '<<=== Modifica

    With ThisWorkbook

        Set SH1 = .Sheets("Foglio1")

        Set SH2 = .Sheets("Foglio2")

    End With

    Set rngTabella = SH2.Range(sTabella)

    dDiametro = Rng_Diametro.Value

    Set oDic = CreateObject("Scripting.Dictionary")

    With oDic

        For Each rCell In rngTabella.Columns(1).Cells

            If rCell.Value = dDiametro Then

                dRaggio = rCell.Offset(0, 1).Value

                If Not .exists(dRaggio) Then

                    .Add Key:=dRaggio, Item:=Nothing

                End If

            End If

            Next rCell

            arrKeys = .keys

    End With    

    With Me.ComboBox1

        .List = arrKeys

        .ListIndex = 0

    End With

End Sub

'-------->>

Private Sub ComboBox1_Click()

  Rng_Raggio.Value = Me.ComboBox1.Value

End Sub

'<<========

Potresti scaricare il mio file di prova Andrea20200604.xlsm

===

Regards,

Norman