Listbox

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Ciao a tutti
Sono capitato in un errore di visualizzazione, prima funzionava e mentre mettevo a posto un 2° problema non riesco più vedere le 9 colonne della ListBox? Dov'è l'errore?

1°) In foglio1, premo il tasto (scelgo un "dato" in "DES" e vedo solo la 1° colonna)
2°) Stavo provando a premere a "casaccio" le 4 Combobox e noto alcuni "particolari strani" e poi va in tilt.
Dovrebbe azzerare la ListBox e ricrearLa col valore scelto nella Combobox?

Files = Test_listbox-2.xlsm
Grazie mille

Allegati:

You must be logged in to view attached files.

[nicola spanuPartecipante nicola spanu]

Ciao Raffaele credo di aver trovato il problema delle combox.

Vedi il codice sotto riportato.

i duplicati non devono essere eliminati in quanto i codici nella prima colonna sono univoci

Rimane ancora il problema della visualizzazione della 2° colonna in poi 

 

 

 

 

 

Sub Auto_Open() ' DA CAMBIARE in Sub Auto_Open()
Dim wk1 As Workbook: Set wk1 = ThisWorkbook
Dim sh1 As Worksheet: Set sh1 = wk1.Worksheets("DB")
Dim wbTo As Workbook, wsTo As Worksheet
Dim Ur As Long
Dim Percorso As String
'Percorso = ThisWorkbook.Path & "\Database.xlsx" ' da eliminare
Percorso = "\\CLUSTERFS\Share\Piano Marketing\Db_Master\Db_Aggiorna_db_new\Database.xlsx"
Ur = sh1.Range("A" & Rows.Count).End(xlUp).Row
If Ur > 1 Then sh1.Range("A1:T" & Ur) = ""
Application.ScreenUpdating = False
Set wbTo = Application.Workbooks.Open(Percorso)
Set wsTo = wbTo.Worksheets("Archivio")
Ur = wsTo.Range("A" & Rows.Count).End(xlUp).Row
wsTo.Range("A1:I" & Ur).Copy
sh1.Cells(1, 1).PasteSpecial
Application.DisplayAlerts = False
wbTo.Close (1)
Application.DisplayAlerts = True

sh1.Range("B2:B" & Ur).Copy Destination:=sh1.Range("L2")
'sh1.Range("L1:L" & Ur - 1).RemoveDuplicates Columns:=1, Header:=xlNo
sh1.Range("E2:E" & Ur).Copy Destination:=sh1.Range("N2")
'sh1.Range("N1:N" & Ur - 1).RemoveDuplicates Columns:=1, Header:=xlNo
sh1.Range("F2:F" & Ur).Copy Destination:=sh1.Range("P2")
'sh1.Range("P1:P" & Ur - 1).RemoveDuplicates Columns:=1, Header:=xlNo
sh1.Range("G2:G" & Ur).Copy Destination:=sh1.Range("R2")
'sh1.Range("R1:R" & Ur - 1).RemoveDuplicates Columns:=1, Header:=xlNo

Application.ScreenUpdating = True
Sheets("Foglio1").Activate
Set wbTo = Nothing
Set wsTo = Nothing
Set sh1 = Nothing
Set wk1 = Nothing
End Sub

[nicola spanuPartecipante nicola spanu]

Sorry ...solo dalla colonna L non devono essere rimossi i duplicati

 

 

[nicola spanuPartecipante nicola spanu]

con questo codice dichiarando in tutte le colonne "Sheets("DB").Cells

Ora si vedono tutte le colonne nella listbox

Credo...

 

 

 

 

 

Private Sub ComboBox1_Change()
Dim Ur As Long, Rg As Long, Rng As Range, Str As String, firstAddress
Application.EnableEvents = False
ListBox1.Clear
'ListBox1.ListIndex = ListBox1.ListIndex
'ComboBox1 = ""
ComboBox2 = ""
ComboBox3 = ""
ComboBox4 = ""
Application.EnableEvents = True
Str = ComboBox1.Value
Ur = Sheets("DB").Range("A" & Rows.Count).End(xlUp).Row
With Sheets("DB").Range("B1:B" & Ur)
Set Rng = .Find(Str, SearchDirection:=xlPrevious)
If Not Rng Is Nothing Then
firstAddress = Rng.Address
Do
Rg = Rng.Row
ListBox1.AddItem
ListBox1.List(ListBox1.ListCount - 1, 0) = Sheets("DB").Cells(Rg, 1)
ListBox1.List(ListBox1.ListCount - 1, 1) = Sheets("DB").Cells(Rg, 2)
ListBox1.List(ListBox1.ListCount - 1, 2) = Sheets("DB").Cells(Rg, 3)
ListBox1.List(ListBox1.ListCount - 1, 3) = Sheets("DB").Cells(Rg, 4)
ListBox1.List(ListBox1.ListCount - 1, 4) = Sheets("DB").Cells(Rg, 5)
ListBox1.List(ListBox1.ListCount - 1, 5) = Sheets("DB").Cells(Rg, 6)
ListBox1.List(ListBox1.ListCount - 1, 6) = Sheets("DB").Cells(Rg, 7)
ListBox1.List(ListBox1.ListCount - 1, 7) = Sheets("DB").Cells(Rg, 8)
ListBox1.List(ListBox1.ListCount - 1, 8) = Sheets("DB").Cells(Rg, 9)
Set Rng = .FindNext(Rng)
Loop While Not Rng Is Nothing And Rng.Address <> firstAddress
End If
End With
Set Rng = Nothing
End Sub

[Raffaele53Partecipante Raffaele53 Karma: 23 pts]

Grazie, avevo appena risolto il 1° problema

Per il 2° problema (ho capito dove sia mà non ho trovato un metodo migliore) ed ho risolto con una soluzione stramba. Inserendo ad ogni combobox una riga >>>If ComboBox(n).Value = "" Then Exit Sub

[Autore]

Articoli