• DİKKAT

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

listbox veya buton şeklinde aktarım.

  • Konbuyu başlatan Konbuyu başlatan desk
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Ekim 2005
Mesajlar
288
Excel Vers. ve Dili
excel 2010 türkçe
veriler dosyasından örnek dosyasına listbox veya butonla aktarım.?
 

Ekli dosyalar

Dosyanız ektedir.:cool:
Kod:
Sub kapali_aktar()
Dim conn As Object, rs As Object
Sheets("Sayfa1").Select
If Range("A1").Value = "" Then
    MsgBox "A1 Hücresine Kod numarası giriniz.", vbCritical, "UYARI"
    Range("A1").Select
    Exit Sub
End If
Application.ScreenUpdating = False
Set conn = CreateObject("Adodb.connection")
Set rs = CreateObject("Adodb.recordset")
conn.Open "provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & _
"\veriler.xls;extended properties=""excel 8.0;hdr=yes"""
rs.Open "select * from [Sayfa1$];", conn, 1, 1
rs.MoveFirst
Do While Not rs.EOF
    If rs(0) = Range("A1").Value Then
        For k = 1 To 3
            sat = Cells(65536, k).End(xlUp).Row + 1
            If sat >= 65533 Then
                MsgBox "Satır doldu diğer kayıtlar girilmedi", vbCritical, "UYARI"
                Exit Do
            End If
            Cells(sat, k).Value = rs(k - 1).Value
        Next k
        sat = Cells(65536, 5).End(xlUp).Row + 1
        If sat >= 65533 Then
            MsgBox "Satır doldu diğer kayıtlar girilmedi", vbCritical, "UYARI"
            Exit Do
        End If
        Cells(sat, 5).Value = rs(3).Value
    End If
    rs.movenext
Loop
rs.Close
conn.Close
Set rs = Nothing
Set conn = Nothing
Application.ScreenUpdating = True
MsgBox "Aktarım yapıldı." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Sanırım burda kendimden kaynaklı olarak sorunumu tam ifade edemedim. Listbox da 1 yazdığımda 1 nonun bilgilerini vermesi gerekiyordu. Butondada sanırım a1 hücresinde 1 yazıyorsa 1 in bilgilerini dök gibi yazmalıydım. Birde örneğimdede var ben bilgileri satır halinde değil no bir hücreye ad farklı bir hücreye sütuna soyad farklı bir hücreye sütuna veya satıra gibi dağıtmak istiyorum.
 
Bu konuda yardımcı olabilecek arkadaş yokmu?
 
dosyayı güncelledim 2 numaralı mesajda.:cool:
 
Çok çok tşk ederim üstad. Sen buranın baş tacısın :) Bu kod gayet güzel çalışıyor fakat burda no ad soyad bastıktan sonra bir alta yine basıyor ayrıca benim istediğim 1 nolu satırdaki verileri alabildikten sonra istediğim hücreye istediğim hücreyi basabilmek. Bu kodda no ad soyad yazan yazının altına basıyor ben sadece veri bassın istiyorum. Satırdaki verileri alldıktan sonra cell lerini belirleyebileceğim bir kod dizimi istiyorum. Senin yazdığın kod ya ileri düzey yada ben anlayamıyorum. Hücrelerini nasıl belirleyebileceğimi anlayamadım.

Şu örnekteki gibi çekme işlemi.
 

Ekli dosyalar

Geri
Üst