[VBA] Elegantnije punjenje listboxa

[ anakin14 @ 18.03.2008. 13:56 ] @

Code:

Sub lista()
Sheets("pomocni").Select
Range("a2:n" & Range("a65000").End(xlUp).row + 1).ClearContents
Application.CutCopyMode = False
Sheets("baza podataka").Select
ListBox1.Clear
Selection.AutoFilter Field:=1, Criteria1:=Format(dat(1), "d-mmm")
Selection.AutoFilter Field:=2, Criteria1:=obj(1)
Selection.AutoFilter Field:=3, Criteria1:=kont(1)
Selection.AutoFilter Field:=4, Criteria1:=dob(1)

If Range("a65000").End(xlUp).row > 1 Then
p = Range("a65000").End(xlUp).row
Range("a2:n" & p).Copy
    Sheets("pomocni").Select
    Range("A2").Select
    ActiveSheet.Paste
    tabela = Range("a2:n" & Range("a65000").End(xlUp).row)
For p = 1 To UBound(tabela)
With ListBox1
    .AddItem tabela(p, 1)
    .List(ListBox1.ListCount - 1, 0) = tabela(p, 1)
    .List(ListBox1.ListCount - 1, 1) = tabela(p, 2)
    .List(ListBox1.ListCount - 1, 2) = tabela(p, 3)
    .List(ListBox1.ListCount - 1, 3) = tabela(p, 4)
    .List(ListBox1.ListCount - 1, 4) = tabela(p, 6)
    .List(ListBox1.ListCount - 1, 5) = tabela(p, 7)
    .List(ListBox1.ListCount - 1, 6) = tabela(p, 8)
    .List(ListBox1.ListCount - 1, 7) = tabela(p, 9)
    .List(ListBox1.ListCount - 1, 8) = tabela(p, 10)
    .List(ListBox1.ListCount - 1, 9) = tabela(p, 5)
    .TopIndex = .ListCount - 1
End With
Next p

Sheets("baza podataka").Select
If ActiveSheet.FilterMode Then
    ActiveSheet.ShowAllData
  End If
Range("a1").End(xlDown).Offset(1, 0).Select
End Sub

Kao sto vidite da bi napunio listbox, prvo filterujem bazu podataka tako da ostanu podaci kojima zelim da je napunim, pa ih kopiram u pomocni sheet pa promenjlivoj tabela (variant) dodeljujem range iz pomocnog sheeta pa onda punim sa njim listbox... Mislim da sigurno postoji elegantnije resenje da popunim listbox podacima iz baze po zadatim kriterijumima (dat,kont,obj,dob).

Hvala puno na pomoci i pozdrav!!!

[ Jpeca @ 18.03.2008. 19:55 ] @

Nisam ispratio ceo primer (lakše bi mi bilo kad bih imao i odgovarajuću tabelu), ali jedan od problema je da izbegneš kopiranje nakon postavljanja autofiltra

Rešenje bi bilo da nakon postavljanja autofiltar prođeš petljom kroz sve redove i ispitaš da li je red iz filtriranog opsega ili ne (Hidden = true)

Code:

For r = 2 To rwKraj                                    ' Za sve redove iz originalnog (nefiltriranog) opsega
   If shP.Rows(r).Hidden Then GoTo Sledeci    ' Preskoci skrivene redove
   ' Sad dodaj u list box
   End if
Sledeci:
Next r

[ anakin14 @ 19.03.2008. 10:02 ] @

Ali cini mi se da se sa kopiranjem manje vremena trosi nego sa petljom jer petlja opet mora da prodje kroz 30000 slogova i da proveri koji je hidden koji nije...

Na koji nacin u izvornom kodu uopste funkcionise komanda SELECT u SQL-u ?

[ Jpeca @ 20.03.2008. 10:59 ] @

Što se tiče efikasnosti možeš direktno da pridružiš izvor podataka list boxu preko svojstva RowSorce

Code:
Me.ListBox1.RowSource = "Sheet2!A1:N3000"

ali pošto ti je redosled kolona u list boxu različit od onog u opsegu ne znam da li ti ovo odgovara.

Citat:

Na koji nacin u izvornom kodu uopste funkcionise komanda SELECT u SQL-u ?

Ako je to bilo pitanje, za čitanje iz neke baze podataka, nakon što uspostaviš konekciju sa bazom metodom Execute Connection objekta dobiješ podatke u record set

Code:

Dim oConn As ADODB.Connection
Dim sConn As String
Dim oRS As ADODB.Recordset
Dim oRSKupac As ADODB.Recordsetđ
...
Set oConn = New ADODB.Connection
oConn.ConnectionString = sConn
oConn.Open
Set oRS = oConn.Execute(sSQL)
' Korstiš record set

gde je sSQL - SQL komanda kao običan string (između znaka navoda)

[ anakin14 @ 20.03.2008. 11:34 ] @

ovo sa rowsoruce bi odgovaralo samo ako mogu da pridruzim recimo range("a1:n3000") samo visible cells?
Jel moze ovako?