DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sağolun ben mantıken böyle istemiyorum hocam.Ziynettin üstadın kodundaki aa yı öyle dizi içine almak sadece istediğimHız için böyle yapın.
Ekli dosyayı deneyin.
DOSYA İNDİR
Kod:Private Sub UserForm_Initialize() Dim aa(), son As Long son = 4 ListBox1.ColumnCount = 6 ListBox1.ColumnWidths = "50;0;50;0;50" ListBox1.RowSource = "A2:E4" End Sub
Bu kod tam olmuş.Sadece listboxun en altına boşluk ekliyor.
sağolun.
Rowsource ile alına dediğiniz gibi.Fakat ben dizi içinde felan arama yapacağım.Rowsourcede yardımcı sütun felan işi gerekiyor yada sütun filtreleme felan.En iyi ve en hızlı yöntem rowsource dir.Bu yöntemle verileri alırsanız hücredeki formatıda aynen alırsınız.
Dizi yöntemde ise verileri alırken tek tek formatlamanız lazım.Buda sayısal ve tarihleri metin olarak alır ve sayfaya aktarırkende metin olarak aktarır.
Verilerinizi sayfaya kaydederken birde ID sütunu yapın.Buraya her kayıtta benzersiz bir sayı girin.Sonrada o ide göre find komutu ile verilerinizi çağırıp textboxlara getireebilir ve düzenleme ve silme işlerini rahatlıkla yaparsınız.Mesela ben öyle yapıyorum.Bu işi bilenlerde bu konuyu böyle yapıyorlar.Rowsource ile alına dediğiniz gibi.Fakat ben dizi içinde felan arama yapacağım.Rowsourcede yardımcı sütun felan işi gerekiyor yada sütun filtreleme felan.
Sağolun tam istediğim gibi olmuş.ReDim arr(1 To son - 1, 1 To UBound(aa) + 1)
işte bu
For i = 1 To son - 1
arr(i, 1) = aa(0)(i, 1)
arr(i, 2) = aa(1)(i, 1)
arr(i, 3) = aa(2)(i, 1)
Next i
Private Sub CommandButton1_Click()
Dim aa(), arr()
son = Range("A" & Rows.Count).End(3).Row
aa = Array(Range("A2:A" & son).Value, Range("C2:C" & son).Value, Range("D2:D" & son).Value)
ListBox1.ColumnCount = UBound(aa) + 1
ListBox1.Clear
ReDim arr(1 To son - 1, 1 To UBound(aa) + 1)
For i = 1 To son - 1
arr(i, 1) = aa(0)(i, 1)
arr(i, 2) = aa(1)(i, 1)
arr(i, 3) = aa(2)(i, 1)
Next i
ListBox1.List = arr
End Sub
Private Sub CommandButton1_Click()
Dim myArr()
myFile = ThisWorkbook.FullName
ListBox1.ColumnCount = 3
ListBox1.ColumnWidths = "60;60;60"
ListBox1.Clear
Set objConnection = CreateObject("ADODB.Connection")
strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _
"Data Source='" & ThisWorkbook.FullName & "';" & _
"Extended Properties=""Excel 12.0 Macro;HDR=No"""
strQuery = "Select F1, F3, F5 from [Sheet1$]"
objConnection.Open strConnection
Set RS = objConnection.Execute(strQuery)
myArr = RS.GetRows
ListBox1.List = Application.Transpose(myArr)
Erase myArr
Set RS = Nothing
Set objConnection = Nothing
End Sub
Transpose kullanılmış.Acaba şu 65536lık satır olayı gibi sorun olurmu.Daha önce başka konu altında yazışmıştık.Transpose görünce hep aklıma bu geliyorDöngü kullanmadan A, C ve E sütunlarındaki verileri önce diziye, oradan da ListBox nesnesine yüklemek için alternatif kod;
.Kod:Private Sub CommandButton1_Click() Dim myArr() myFile = ThisWorkbook.FullName ListBox1.ColumnCount = 3 ListBox1.ColumnWidths = "60;60;60" ListBox1.Clear Set objConnection = CreateObject("ADODB.Connection") strConnection = "Provider=Microsoft.ACE.OLEDB.12.0;" & _ "Data Source='" & ThisWorkbook.FullName & "';" & _ "Extended Properties=""Excel 12.0 Macro;HDR=No""" strQuery = "Select F1, F3, F5 from [Sheet1$]" objConnection.Open strConnection Set RS = objConnection.Execute(strQuery) myArr = RS.GetRows ListBox1.List = Application.Transpose(myArr) Erase myArr Set RS = Nothing Set objConnection = Nothing End Sub
myArr = Rs.getrows
ListBox1.List = Application.Transpose(myArr)