Ciao Claudio,
Cerco di spiegare il mio problema .
Ho una tabella di excel nel Foglio1 , composta da tre colonne (A2:A1500,B2:B1500,C2:C1500) che contengono :
Colonna A nome Artista
Colonna B Nome Opera
Colonna C Descrizione dettagliata dell'Opera (celle contenenti molto Testo , copiate e incollate da Word ...)
Ho realizzato una UserForm con 2 ListBox
ListBox1 carica dal Foglio1 Le 3 Intestazioni (Nome Artista,Nome Opera , Descrizione )
Cliccando su una delle Voci caricate in ListBox1 (ListBox1.Click) , nella ListBox2 , viene Caricato l'Elenco delle Opere .
Vorrei Inserire una Terza ListBox (oppure ComboBox ..) che al Click sulla voce di interesse (il Nome dell'Opera ..) in ListBox2 , carichi nella nuova ListBox (ListBox3) la Descrizione dell'Opera .... che poi tramite CommandButton , andro' a copiare in una
cella nel Foglio di destinazione ...
...Non riesco a scrivere le istruzioni esatte per far caricare nella ListBox3 , solo i valori (testo) della cella adiacente a quella selezionata in ListBox2
Es.: se Valore selezionato in ListBox2 e' nella Cella B1 , nella ListBox3 carica Valore(testo) della Cella C1
A titolo di esempio, prova qualcosa del genere:
In un modulo standard, incolla:
'=========>>
Option Explicit
'--------->>
Public Sub Tester()
UserForm1.Show vbModeless
End Sub
'--------->>
Public Function SortedList(V As Variant)
Dim oSortedList As Object
Dim arrOut() As Variant
Dim sStr As String
Dim i As Long, j As Long
Set oSortedList = CreateObject("System.Collections.Sortedlist")
With oSortedList
For i = LBound(V) To UBound(V)
sStr = V(i, 1)
If Not sStr = vbNullString Then
If Not .ContainsKey(sStr) Then
.Add Key:=sStr, Value:=i
End If
End If
Next i
ReDim arrOut(1 To .Count)
For j = 0 To .Count - 1
arrOut(j + 1) = .GetKey(j)
Next j
End With
SortedList = arrOut
End Function
'--------->>
Public Function LastRow(SH As Worksheet, _
Optional Rng As Range, _
Optional minRow As Long = 1)
If Rng Is Nothing Then
Set Rng = SH.Cells
End If
On Error Resume Next
LastRow = Rng.Find(What:="*", _
after:=Rng.Cells(1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
On Error GoTo 0
If LastRow < minRow Then
LastRow = minRow
End If
End Function
'<<=========
Nel modulo di una Userform, incolla il seguente codice:
'=========>>
Option Explicit
Private vArr As Variant
Private vArr2 As Variant
Private WB As Workbook
Private SH As Worksheet
Private Rng As Range
Private iColWidth As Double
'--------->>
Private Sub UserForm_Initialize()
Dim LRow As Long
Const sFoglio As String = "Foglio1" '<<=== Modifica
Set WB = ThisWorkbook
Set SH = WB.Sheets(sFoglio)
With SH
LRow = LastRow(SH, .Columns("A:A"))
Set Rng = .Range("A2:C" & LRow)
End With
With Rng
iColWidth = .Columns(.Columns.Count).ColumnWidth
vArr = .Columns(2).Value
vArr2 = .Columns(3).Value
End With
With Me
With .lbxArtista_Opera
.RowSource = Rng.Address(External:=True)
.ColumnHeads = True
.ColumnCount = Rng.Columns.Count - 1
End With
With .tbxDescrizioneOpera
.MultiLine = True
.WordWrap = True
End With
With .cbEsci
.Caption = "Esci!"
.ForeColor = vbRed
.AutoSize = True
End With
With .cbCopiaDescrizione
.Caption = "Copia Descrizione!"
.ForeColor = vbGreen
.Visible = False
.Enabled = False
End With
End With
End Sub
'--------->>
Private Sub lbxArtista_Opera_Click()
Me.lbxArtista.List = SortedList(vArr)
End Sub
'--------->>
Private Sub lbxArtista_Click()
Dim res As Variant
Dim sStr As String
Dim i As Long
Dim bFlag As Boolean
With Me
With .lbxArtista
sStr = .List(.ListIndex)
End With
For i = 1 To UBound(vArr)
If vArr(i, 1) = sStr Then
bFlag = True
Exit For
End If
Next i
If bFlag Then
.tbxDescrizioneOpera.Value = vArr2(i, 1)
End If
With .cbCopiaDescrizione
.Visible = True
.Enabled = True
End With
End With
End Sub
'--------->>
Private Sub cbCopiaDescrizione_Click()
Dim Rng As Range, destRng As Range
Dim destSH As Worksheet
Dim sAddress As String
Set destSH = SH.Next
Set Rng = destSH.Range("A1")
sAddress = Rng.Address(0, 0, , 1)
On Error Resume Next
Set destRng = Application.InputBox(Prompt:="Seleziona la cella da ricevere la descrizione della scelta opera", _
Title:="Cella destinario!", _
Default:=sAddress, _
Type:=8)
On Error GoTo 0
If Not destRng Is Nothing Then
On Error GoTo XIT
Application.ScreenUpdating = False
With destRng
.Value = Me.tbxDescrizioneOpera.Value
.ColumnWidth = iColWidth
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.WrapText = True
End With
Else
Call MsgBox( _
Prompt:="Non hai scelto una destinazione per la descrizione dell'opera", _
Buttons:=vbCritical, _
Title:="DATI NON COPIATI")
End If
XIT:
Application.ScreenUpdating = True
End Sub
'--------->>
Private Sub cbEsci_Click()
Unload Me
End Sub
'<<=========
Nota che ho sostituito il terzo oggetto ListBox con un controllo Textbox in quanto mi pare sia piu adatto ma, se vuoi, potrei modificare il codice per gestire l'uso di un terzo controllo ListBox.
Potresti scaricare il mio file di prova Claudio20161224.xlsm a:
https://www.dropbox.com/s/iq2hht860rsw13o/Claudio20161224.xlsm?dl=0
===
Regards,
Norman
![](data:image/svg+xml, %3Csvg xmlns='http://www.w3.org/2000/svg' height='64' class='font-weight-bold' style='font: 600 30.11764705882353px "SegoeUI", Arial' width='64'%3E%3Ccircle fill='hsl(128, 8%, 22%)' cx='32' cy='32' r='32' /%3E%3Ctext x='50%25' y='55%25' dominant-baseline='middle' text-anchor='middle' fill='%23FFF' %3EA%3C/text%3E%3C/svg%3E)
