• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

excel döngüleri yardım

  • Konbuyu başlatan Konbuyu başlatan ikikan
  • Başlangıç tarihi Başlangıç tarihi
ikikan

ikikan

Katılım
3 Mart 2009
Mesajlar
519
Excel Vers. ve Dili
excel 2003 tr
yer.MoveFirst
Do Until yer.EOF
ListBox2.AddItem yer(0)
yer.MoveNext
Loop

döngüsünü ( A1:A8) aralığı için nasıl ayarlarız ?
 
Merhaba,
ilgili prosedürün tamamını ya da dosyayı ekleyebilirseniz daha çabuk sonuç alınabilir.
İyi çalışmalar.
 
Workbooks.Open Filename:="C:\deneme.xls"
For a=1 to 8
ListBox2.AddItem Sheets(1).Cells(a,1).value
next
Workbooks("deneme.xls").Close

Sheets(1) ve deneme.xls sayfa ve çalışma kitabını kendi dosyanıza göre değiştirin...
 
turan1971' Alıntı:
Workbooks.Open Filename:="C:\deneme.xls"
For a=1 to 8
ListBox2.AddItem Sheets(1).Cells(a,1).value
next
Workbooks("deneme.xls").Close

Sheets(1) ve deneme.xls sayfa ve çalışma kitabını kendi dosyanıza göre değiştirin...
Genişletmek için tıkla ...

dosya ektedir vermiş oldugunuz kod dişinda açmadan ve kapatmadanda
bilgi almak istiyorum bu sayade kendi içinde sağlamasınıda yapmış olcagını düşünüyorum
 

Ekli dosyalar

Merhaba,
dosyalarınızı inceledim. Şimdi, ilk mesajdaki döngüyü; hangi veriyi, nereye almak için istiyorsunuz. Kolay gelsin.
 
dentex' Alıntı:
Merhaba,
dosyalarınızı inceledim. Şimdi, ilk mesajdaki döngüyü; hangi veriyi, nereye almak için istiyorsunuz. Kolay gelsin.
Genişletmek için tıkla ...

(A1:B8 ) aralıgındaki verileri direk userform üzerindeki listbox1 almak istiyorum
8 satırlı ve 2 sütunluk veri
aryıca veri alınacak hücrelerde veri yoksa boş olarak almasını istiyorum
şimdiden teşekürler
 
Tekrar merhaba,
konu böyle epeyce uzuyor. Userform1 ve PGiriş formlarında Listbox1 var. Pgiriş formu açılırken, Pkart klasöründeki xls uzantılı dosyaları listeliyor. Şimdi bu aşamada ben ne yapacağımı bilemedim...
 
dentex' Alıntı:
Tekrar merhaba,
konu böyle epeyce uzuyor. Userform1 ve PGiriş formlarında Listbox1 var. Pgiriş formu açılırken, Pkart klasöründeki xls uzantılı dosyaları listeliyor. Şimdi bu aşamada ben ne yapacağımı bilemedim...
Genişletmek için tıkla ...

özürdilerim listbox2 verileri alacak yanliş bir ifade kullandım...
 
Formdaki Listbox1 Dbl Click prosedürünü aşağıdaki kodla değiştirerek deneyiniz. İyi çalışmalar.

Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim baglanti As Object, yer As Object, sayfa As Object
Set baglanti = New ADODB.Connection
Set yer = New ADODB.Recordset

ListBox2.Clear
Range("A2:O65536").ClearContents
If ListBox1.Value = "" Then Exit Sub

baglanti.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
ThisWorkbook.Path & "\KartP\" & ListBox1.Value & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
yer.Open "Select * From [CariMüsteri$a1:b8] where F1 Is Not Null;", baglanti, adOpenStatic, adLockOptimistic

s = 0
With ListBox2
.Clear
.ColumnCount = 2
.ColumnWidths = "50;82"
Do While Not yer.EOF
.AddItem
.List(s, 0) = yer("F1")
.List(s, 1) = yer("F2") & ""
s = s + 1
yer.MoveNext
Loop
End With

Range("A2").CopyFromRecordset yer
yer.Close
baglanti.Close


Label1.Caption = ""
Label1.Caption = ListBox1.Value

Dim i As Integer
ListView1.ListItems.Clear
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
    For i = 1 To c
    m = m + 1
            .ListItems.Add , , Cells(i + 10, 1)
            .ListItems(m).SubItems(1) = Cells(i + 10, 2)
            .ListItems(m).SubItems(2) = Cells(i + 10, 3)
            .ListItems(m).SubItems(3) = Cells(i + 10, 4)
            .ListItems(m).SubItems(4) = Cells(i + 10, 5)
            .ListItems(m).SubItems(5) = Cells(i + 10, 6)
            .ListItems(m).SubItems(6) = Cells(i + 10, 7)
            .ListItems(m).SubItems(7) = Cells(i + 10, 8)
            .ListItems(m).SubItems(8) = Cells(i + 10, 9)
            .ListItems(m).SubItems(9) = Cells(i + 10, 10)
            .ListItems(m).SubItems(10) = Cells(i + 10, 11)
            .ListItems(m).SubItems(11) = Cells(i + 10, 12)
            .ListItems(m).SubItems(12) = Cells(i + 10, 13)
            .ListItems(m).SubItems(13) = Cells(i + 10, 14)
            .ListItems(m).SubItems(14) = Cells(i + 10, 15)
            
            Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
ListView1.FullRowSelect = True
End Sub
 
dentex' Alıntı:
Formdaki Listbox1 Dbl Click prosedürünü aşağıdaki kodla değiştirerek deneyiniz. İyi çalışmalar.

Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim baglanti As Object, yer As Object, sayfa As Object
Set baglanti = New ADODB.Connection
Set yer = New ADODB.Recordset

ListBox2.Clear
Range("A2:O65536").ClearContents
If ListBox1.Value = "" Then Exit Sub

baglanti.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
ThisWorkbook.Path & "\KartP\" & ListBox1.Value & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
yer.Open "Select * From [CariMüsteri$a1:b8] where F1 Is Not Null;", baglanti, adOpenStatic, adLockOptimistic

s = 0
With ListBox2
.Clear
.ColumnCount = 2
.ColumnWidths = "50;82"
Do While Not yer.EOF
.AddItem
.List(s, 0) = yer("F1")
.List(s, 1) = yer("F2") & ""
s = s + 1
yer.MoveNext
Loop
End With

Range("A2").CopyFromRecordset yer
yer.Close
baglanti.Close


Label1.Caption = ""
Label1.Caption = ListBox1.Value

Dim i As Integer
ListView1.ListItems.Clear
c = WorksheetFunction.CountA(ActiveSheet.Range("A:A"))
With ListView1
    For i = 1 To c
    m = m + 1
            .ListItems.Add , , Cells(i + 10, 1)
            .ListItems(m).SubItems(1) = Cells(i + 10, 2)
            .ListItems(m).SubItems(2) = Cells(i + 10, 3)
            .ListItems(m).SubItems(3) = Cells(i + 10, 4)
            .ListItems(m).SubItems(4) = Cells(i + 10, 5)
            .ListItems(m).SubItems(5) = Cells(i + 10, 6)
            .ListItems(m).SubItems(6) = Cells(i + 10, 7)
            .ListItems(m).SubItems(7) = Cells(i + 10, 8)
            .ListItems(m).SubItems(8) = Cells(i + 10, 9)
            .ListItems(m).SubItems(9) = Cells(i + 10, 10)
            .ListItems(m).SubItems(10) = Cells(i + 10, 11)
            .ListItems(m).SubItems(11) = Cells(i + 10, 12)
            .ListItems(m).SubItems(12) = Cells(i + 10, 13)
            .ListItems(m).SubItems(13) = Cells(i + 10, 14)
            .ListItems(m).SubItems(14) = Cells(i + 10, 15)
            
            Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
ListView1.FullRowSelect = True
End Sub
Genişletmek için tıkla ...

ilginiz için teşekür güzel olmuş iki sutunuda göstere biliyoruz bir ekleme daha yaıla bilirmi acaba

A ve B sununda olan veriler sadece 8 satıra kadar aktarılsın döngü 8 satıra gelince dursun mümkünmüdür ?
 
Merhaba, zaten 8. satıra kadar kayıtları okur.

Kod: 
yer.Open "Select * From [CariMüsteri$a1:b8] where F1 Is Not Null;", baglanti, adOpenStatic, adLockOptimistic
 
sayın dentex şimdi farketim listview kodlarımı işeyaramaz hale getiriyor örnek dosyada incelerseniz aktif sayfa kopyalam işlemi olmuyor
 
Merhaba,
bence eklediğiniz orjinal dosyada da hatalı gibi. Veri alınan dosyalarda veri 9. satırdan itibaren başlıyor. Ancak ana dosyanızda 8. satırdan itibaren kopyalanıyor. Firma bilgilerini a1:b8 arası listbox2'ye istiyorsunuz ama ana dosyanızda bunlar için 2. satırdan 7. satıra kadar bir yer ayrılmış. Prosedürü aşağıdaki gibi deneyin, sanırım istediğiniz budur.


Kod: 
Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim baglanti As Object, yer As Object, sayfa As Object
Set baglanti = New ADODB.Connection
Set yer = New ADODB.Recordset

ListBox2.Clear
Range("A2:O65536").ClearContents
If ListBox1.Value = "" Then Exit Sub

baglanti.Open "Provider=Microsoft.Ace.Oledb.12.0;Data Source=" & _
ThisWorkbook.Path & "\KartP\" & ListBox1.Value & ";Extended Properties=""Excel 12.0;HDR=no;IMEX=1"";"
yer.Open "Select * From [CariMüsteri$] where F1 Is Not Null;", baglanti, adOpenStatic, adLockOptimistic


s = 0
With ListBox2
.Clear
.ColumnCount = 2
.ColumnWidths = "50;82"
Do While Not yer.EOF And s < 6
.AddItem
.List(s, 0) = yer("F1")
.List(s, 1) = yer("F2") & ""
s = s + 1
yer.MoveNext
Loop
End With
yer.MoveFirst

Range("A2").CopyFromRecordset yer
yer.Close
baglanti.Close


Label1.Caption = ""
Label1.Caption = ListBox1.Value

Dim i As Integer
ListView1.ListItems.Clear
c = WorksheetFunction.CountA(ActiveSheet.Range("A9:A" & 65536))
With ListView1
    For i = 1 To c
    m = m + 1
            .ListItems.Add , , Cells(i + 8, 1)
            .ListItems(m).SubItems(1) = Cells(i + 8, 2)
            .ListItems(m).SubItems(2) = Cells(i + 8, 3)
            .ListItems(m).SubItems(3) = Cells(i + 8, 4)
            .ListItems(m).SubItems(4) = Cells(i + 8, 5)
            .ListItems(m).SubItems(5) = Cells(i + 8, 6)
            .ListItems(m).SubItems(6) = Cells(i + 8, 7)
            .ListItems(m).SubItems(7) = Cells(i + 8, 8)
            .ListItems(m).SubItems(8) = Cells(i + 8, 9)
            .ListItems(m).SubItems(9) = Cells(i + 8, 10)
            .ListItems(m).SubItems(10) = Cells(i + 8, 11)
            .ListItems(m).SubItems(11) = Cells(i + 8, 12)
            .ListItems(m).SubItems(12) = Cells(i + 8, 13)
            .ListItems(m).SubItems(13) = Cells(i + 8, 14)
            .ListItems(m).SubItems(14) = Cells(i + 8, 15)
            
            Next
End With
ListView1.FullRowSelect = True
ListView1.Gridlines = True
ListView1.FullRowSelect = True
End Sub
 
biryerde hata oldugunu anlamıştım lakin çözümü birtürlü bulamadım, bu kod tam istediğim gibi olmuş teşekürler program bitiginde sizinde adınız geçecek teşekür ederim
veri alma işlemini sayenizde bitirdim ...
şimdi veri yollama işlemi ve raporlama kaldı
 
Rica ederim, iyi çalışmalar.
 
bu kod neden çalışmıyor

ListView1.ListItems.Clear
Dim l As Integer
m = 0
With ListView1
Do While Not yer.EOF And m < 6
ListItems.Add , , yer("F1")
ListItems(m).SubItems(1) = yer("F2") & ""
m = m + 1
yer.MoveNext
Loop
End With
yer.MoveFirst
 
Merhaba,
kodu deneme şansım olmadı ama;
Kod: 
ListView1.ListItems.Clear
Dim l As Integer
m = 0
With ListView1
Do While Not yer.EOF And m < 6
.ListItems.Add , , yer("F1")
.ListItems(m).SubItems(1) = yer("F2") & ""
m = m + 1
yer.MoveNext
Loop
End With
yer.MoveFirst
şeklinde bir deneyin, kolay gelsin.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst