Ciao Geacs,
Ciao Norman, ti ringrazio ancora di quest'ultimo codice pubblicato.
Bene! Grazie a te del cortese riscontro.
Visto che sei stato tu a stuzzicare la mia fame di perfezionare quello che già funziona benissimo, se dovessi utilizzarlo per aggiornare in un'altra cartella di lavoro che contiene una userform con 6 ComboBox numerate da ComboBox1 a ComboBox6. Come modificarlo per fare in modo che si aggiornino?
Sarebbe stato utile avere un file di esempio che mostrasse la configurazione dei dati delle liste che alimentano i sei controlli ComboBox😊
Tuttavia, almeno come punto di partenza, prova quanto segue:
Nel modulo di codice Modulo1:
'========>>
Option Explicit
Public vArr_Arrays As Variant
Public vArr1() As Variant, vArr2() As Variant, vArr3() As Variant, vArr4() As Variant, vArr5() As Variant, vArr6() As Variant
Public bFlag As Boolean
Public UForm As UserForm
Public Rng_Elenchi As Range
Public vArr_Combo() As Variant
Public Const sPrime_Celle_Elenchi As String = "Q2,S2,U2,W2,X2,Y2" '<<=== Modifica
'-------->>
Public Sub Avvia_Userform()
bFlag = True
UserForm1.Show vbModeless
End Sub
'--------->>
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 codice del Foglio1
'========>>
Option Explicit
'-------->>
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rng As Range, Rng2 As Range, rCell As Range
Dim myUserform As UserForm
Dim CBox As MSForms.ComboBox
Dim vArr\_Temp As Variant
Dim vSplit As Variant
Dim Res As Variant
Dim i As Long, iCtr As Long, jCtr As Long
Dim LRow As Long, iCol As Long
On Error Resume Next
Set myUserform = UForm
If myUserform Is Nothing Then Exit Sub
On Error GoTo 0
If Not bFlag Then Exit Sub
Set Rng = Me.Range(sPrime\_Celle\_Elenchi)
Set Rng2 = Intersect(Rng.EntireColumn, Target)
If Not Rng2 Is Nothing Then
vSplit = Split(Rng.Address, ",")
Res = Application.Match(Rng2.Address, vSplit)
LRow = LastRow(Me, Rng2.EntireColumn)
With Rng
Set Rng\_Elenchi = Rng2.EntireColumn.Cells(Rng.Row).Resize(LRow - Rng.Row + 1)
End With
With Rng\_Elenchi.Cells
If Not UForm Is Nothing Then
vArr\_Temp = Rng\_Elenchi.Value
ReDim vArr(1 To UBound(vArr\_Temp))
For i = 1 To .Count
If Not IsEmpty(.Item(i, 1)) Then
iCtr = iCtr + 1
vArr(iCtr) = vArr\_Temp(i, 1)
End If
Next i
With vArr\_Combo(Res - 1)
.List = vArr
.ListIndex = 0
End With
End If
End With
End If
End Sub
'<<========
Nel modulo di codice della Userform
'========>>
Option Explicit
Dim SH As Worksheet
'-------->>
Private Sub UserForm_Initialize()
Dim Rng As Range, Rng1 As Range, Rng2 As Range, Rng3 As Range
Dim Rng4 As Range, Rng5 As Range, Rng6 As Range
Dim vArr() As Variant, vArr\_Temp As Variant
Dim vArr\_Prime\_Celle As Variant
Dim vArr\_Elenchi() As Variant
Dim i As Long, iCtr As Long
Dim LRow As Long
Dim UB As Long
Dim CBox As MSForms.ComboBox
Dim ii As Long
Const sFoglio As String = **"Foglio1" '<<=== Modifica**
Const iMax\_Numero\_Nomi = **50 '<<=== Modifica**
Set SH = ThisWorkbook.Sheets(sFoglio)
With SH
vArr\_Prime\_Celle = Split(sPrime\_Celle\_Elenchi, ",")
ReDim vArr\_Elenchi(1 To UBound(vArr\_Prime\_Celle) + 1)
Set Rng = .Range(vArr\_Prime\_Celle(0))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng1 = Rng.Resize(LRow - .Row + 1)
End With
Set Rng = .Range(vArr\_Prime\_Celle(1))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng2 = Rng.Resize(LRow - .Row + 1)
End With
Set Rng = .Range(vArr\_Prime\_Celle(2))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng3 = Rng.Resize(LRow - .Row + 1)
End With
Set Rng = .Range(vArr\_Prime\_Celle(3))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng4 = Rng.Resize(LRow - .Row + 1)
End With
Set Rng = .Range(vArr\_Prime\_Celle(4))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng5 = Rng.Resize(LRow - .Row + 1)
End With
Set Rng = .Range(vArr\_Prime\_Celle(5))
LRow = LastRow(SH, Rng.EntireColumn)
With Rng
Set Rng6 = Rng.Resize(LRow - .Row + 1)
End With
End With
vArr\_Elenchi = VBA.Array(Rng1, Rng2, Rng3, Rng4, Rng5, Rng6)
vArr\_Combo = VBA.Array(ComboBox1, ComboBox2, ComboBox3, ComboBox4, ComboBox5, ComboBox6)
ReDim vArr\_Arrays(LBound(vArr\_Elenchi) To UBound(vArr\_Elenchi))
Set UForm = Me
For ii = LBound(vArr\_Elenchi) To UBound(vArr\_Elenchi)
If ii = 3 Then Stop
vArr\_Temp = vArr\_Elenchi(ii).Value
UB = UBound(vArr\_Temp)
ReDim vArr(1 To UB)
For i = 1 To UB
With Rng.Cells
If Not IsEmpty(.Item(i, 1)) Then
iCtr = iCtr + 1
vArr(iCtr) = vArr\_Temp(i, 1)
End If
End With
Next i
vArr\_Arrays(ii) = vArr
ReDim Preserve vArr(1 To iCtr)
If CBool(iCtr) Then
Set CBox = vArr\_Combo(ii)
With CBox
.ListRows = iMax\_Numero\_Nomi
.List = vArr
.ListIndex = 0
End With
Else
Call MsgBox(Prompt:="Controlla l'intervallo dei nomi, " & Rng.Address(0, 0) & " in quanto pare che risulti vuota!", \_
Buttons:=vbCritical, \_
Title:="REPORT")
Exit Sub
End If
iCtr = 0
vArr\_Arrays(ii) = vArr
Next ii
End Sub
'-------->>
Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
bFlag = False
End Sub
'-------->>
Private Sub cbEsci_Click()
Unload Me
End Sub
'<<========
Con questo codice, eventuali modifiche, aggiunte o eliminazioni apportate a una qualsiasi delle sei colonne di dati di interesse si riflettono automaticamente in tempo reale nei controlli ComboBox della Userform aperta.
Per testare il mio codice, ho utilizzato una configurazione dati del seguente tipo:
[![Immagine](https://learn-attachment.microsoft.com/api/attachments/1925d696-c2c8-448d-9782-7267adfadd99?platform=QnA"https://1drv.ms/x/s!AmTW9HzZG8cql2P7yP1AGBIFXbWn?e=SixqVj" title="1drv.ms" rel="ugc nofollow">Geacs20231026.xlsm
===
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)
