[Yardım]  Tablodaki Şartları Sağlayan Bilgileri Almak

Excel hakkındaki soru ya da paylaşımlarınıza kategori bulamadıysanız bu alana yazabilirsiniz.

Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#1)  emnsnmz » 19 Şub 2019 12:18

Merhabalar;

Verilerin girildiği bir kayıt tablosu var, verileri aktarmak istediğim diğer bir sayfam var ancak aktarılacak verileri belirli bir şarta uygun olmasını istiyorum.

örnek dosyayı ekte gönderiyorum.
kayıt sayfasına sırasız ve düzensiz kayıtlar giriliyor.
aylık sayfasına seçtiğim aya ait kayıtların alt alta gelmesini istiyorum ve borç evraklarının üstte sıralanmasını borç evrakları bittikten sonra birkaç satır boş bırakmasını ve alacak evraklarının da onlardan sonra sıralanmasını istiyorum.
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#2)  Ali ÖZ » 19 Şub 2019 15:26

İnceleyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False

    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
         secilen = Split(secim.Name, "Button")(1)
         Exit For
      End If
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F3,F4,F5,F6 FROM [Kay?t$] where [F2]= " & secilen & " order by F3 ASC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 9806
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#3)  emnsnmz » 20 Şub 2019 09:10

Sayın Ali hocam ellerinize sağlık çok güzel olmuş,

Müşteri evrakları ile borç evraklarının arasında otomatik 3 satır boşluk bırakılması mümkün mü ?
Örneğin;

1. Müşteri Senedi ...................
2. Müşteri Çeki .....................
3. Müşteri Çeki .....................


1. Borç Senedi ......................
2. Borç Çeki.......................

Gibi

Saygılarımla.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#4)  emnsnmz » 20 Şub 2019 09:24

Sayın Ali hocam önceki mesajımda belirtmeyi unuttum DBS ödemeleride borç evrakları kısmında görüntülensin
yani örnek aşağıdaki gibi olmalı;

1. Müşteri Senedi ...................
2. Müşteri Çeki .....................
3. Müşteri Çeki .....................


1. Borç Senedi ......................
2. Borç Çeki.......................
3. DBS Ödemesi ..................

Gibi

Saygılarımla.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

REKLAM
Excel Logo XML Oluşturucu
Logo Object Designer ile Uyarlama

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#5)  emnsnmz » 20 Şub 2019 13:39

Merhabalar,

Bi ihtiyaçtan dolayı çek defterimi Ödeme Defteri yapmam gerekti, bankadan çektiğim kredileri de eklemek zorunda kaldım :(

dosyanın son halini ekte gönderiyorum yıl seçimi için aylık sayfasına optionboxlar ekledim. Kredilerde Borç Evrakları bölümünde olacak.
bi önceki ricam (Müşteri Evraklarını ve Borç Evraklarını Ayırma) dosyamın son hali için geçerlidir.

Çok Teşekkürler,
Saygılarımla...
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#6)  emnsnmz » 21 Şub 2019 09:31

Ali ÖZ yazdı:İnceleyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False

    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
         secilen = Split(secim.Name, "Button")(1)
         Exit For
      End If
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F3,F4,F5,F6 FROM [Kay?t$] where [F2]= " & secilen & " order by F3 ASC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub



Ali bey, bu kodlara yıl seçimide eklemek istiyorum yardımcı olabilirmisiniz ?
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

REKLAM
ETA - Excel Konsolide Raporlama
ETA Excel Personel Entegre Raporu

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#7)  emnsnmz » 22 Şub 2019 12:58

Kimse yardımcı olmayacak mı ?

[uzulme] :(
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#8)  Ali ÖZ » 25 Şub 2019 09:51

Dosyanıza göre yazdım kodu.Deneyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False
say = 0
    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
   
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
       If say < 12 Then
         secilenay = Split(secim.Name, "Button")(1)
       Else
         secilenyil = 20 & Split(secim.Name, "Button")(1) + 5
         Exit For
       End If
      End If
      say = say + 1
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F4,F5,F6,F7, F8, F9,F10,F11,F12,F13, F14,F15 FROM [Kay?t$] where [F2]= " & secilenay & " and [F3]= " & secilenyil & " order by F4 DESC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub
Allah bize yeter, O ne güzel vekildir.
حَسْبُنَا اللهُ وَنِعْمَ الْوَكِيلُ
Kullanıcı avatarı
Ali ÖZ
Forum Moderatörü
 
Adı Soyadı:Ali ÖZ
Kayıt: 17 Oca 2013 10:16
Konum: SAKARYA
Meslek: Yazılım
Yaş: 38
İleti: 9806
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Adapazarı/SAKARYA

Cevap: Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#9)  emnsnmz » 25 Şub 2019 10:52

Ali ÖZ yazdı:Dosyanıza göre yazdım kodu.Deneyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False
say = 0
    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
   
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
       If say < 12 Then
         secilenay = Split(secim.Name, "Button")(1)
       Else
         secilenyil = 20 & Split(secim.Name, "Button")(1) + 5
         Exit For
       End If
      End If
      say = say + 1
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F4,F5,F6,F7, F8, F9,F10,F11,F12,F13, F14,F15 FROM [Kay?t$] where [F2]= " & secilenay & " and [F3]= " & secilenyil & " order by F4 DESC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub





rs.Open sorgu, con, 1, 1 bu satırda hata veriyor
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Cevap: Cevap: Tablodaki Şartları Sağlayan Bilgileri A

İleti#10)  emnsnmz » 25 Şub 2019 10:57

emnsnmz yazdı:
Ali ÖZ yazdı:Dosyanıza göre yazdım kodu.Deneyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False
say = 0
    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
   
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
       If say < 12 Then
         secilenay = Split(secim.Name, "Button")(1)
       Else
         secilenyil = 20 & Split(secim.Name, "Button")(1) + 5
         Exit For
       End If
      End If
      say = say + 1
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F4,F5,F6,F7, F8, F9,F10,F11,F12,F13, F14,F15 FROM [Kay?t$] where [F2]= " & secilenay & " and [F3]= " & secilenyil & " order by F4 DESC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub





rs.Open sorgu, con, 1, 1 bu satırda hata veriyor




kayıt olmadığı için hata vermiş sanırım veri girince hata vermeden çalıştı ellerinize sağlık çok teşekkür ederim.

müşteri evrakları ile şirket borçlarının arasına birkaç satır otomatik boşluk bırakılması için birşey yapabilir miyiz ?
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#11)  emnsnmz » 09 Nis 2019 14:20

Borç Çeki Gider
Müşteri Çeki Gelir
Borç Senedi Gider
Müşteri Senedi Gelir
DBS Ödemesi Gider
Kredilerim Gider
Yatırım Kredilerim Gider
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#12)  emnsnmz » 09 Nis 2019 14:27

Selamün Aleyküm,

Daha önce bu çalışmamın "Aylık" sayfasına verial diye bir kod yazdınız. ben bu sayfada gelir ve giderlerin arasında bir miktar boşluk bırakılmasını rica etmiştim ancak onun yerine aşağıdaki listeye göre aylık sayfama eklediğim yeni seçim düğmeleri ile gelir ve giderleri ayrı ayrı veya eskisi gibi tümünü gösteren bir ekleme yapılabilir mi ?

Borç Çeki Gider
Müşteri Çeki Gelir
Borç Senedi Gider
Müşteri Senedi Gelir
DBS Ödemesi Gider
Kredilerim Gider
Yatırım Kredilerim Gider

Saygılarımla, Çok Teşekkürler...
Bu iletideki ekleri görmek için gerekli yetkilere sahip değilsiniz.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#13)  emnsnmz » 10 Nis 2019 16:54

Ali ÖZ yazdı:Dosyanıza göre yazdım kodu.Deneyin.

Kod: Tümünü seç
Sub verial()
  Application.ScreenUpdating = False
say = 0
    Set a = Sheets("Ayl?k")
    Set k = Sheets("Kay?t")
    For Each secim In a.OLEObjects
   
      If secim.progID = "Forms.OptionButton.1" And secim.Object.Value = True Then
       If say < 12 Then
         secilenay = Split(secim.Name, "Button")(1)
       Else
         secilenyil = 20 & Split(secim.Name, "Button")(1) + 5
         Exit For
       End If
      End If
      say = say + 1
    Next
   
    a.Range("b3:m65536").ClearContents
    Set con = CreateObject("Adodb.connection")
    Set rs = CreateObject("Adodb.recordset")
    con.Open "provider=microsoft.ace.oledb.12.0;data source=" & ThisWorkbook.FullName & _
     ";extended properties=""Excel 12.0;hdr=no"""
   
    sorgu = "SELECT F4,F5,F6,F7, F8, F9,F10,F11,F12,F13, F14,F15 FROM [Kay?t$] where [F2]= " & secilenay & " and [F3]= " & secilenyil & " order by F4 DESC"
    rs.Open sorgu, con, 1, 1
    a.Range("b3").CopyFromRecordset rs

    con.Close
    Set con = Nothing
    Set rs = Nothing
  Application.ScreenUpdating = True
End Sub



Sayın Ali ÖZ hocam, sizden rica etsem benim için çok önemli son talebim ile ilgili bana yardımcı olabilir misiniz?
Saygılarımla, Çok Teşekkürler.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ

Cevap: Tablodaki Şartları Sağlayan Bilgileri Almak

İleti#14)  emnsnmz » 12 Nis 2019 14:56

Değerli destekleriniz için teşekkür ederim.
son talebime kimse cevap vermedi ama yinede herkese yürekten teşekkürler.

NOT : bu arada talep ettiğim şeyi çözdüm. insan zorda kalınca yapamayacağı şey yokmuş, onuda kendi kendime kanıtlamış oldum.
Kullanıcı avatarı
emnsnmz
Yeni Başlamış
 
Kayıt: 25 Oca 2017 13:08
Meslek: bilgi işlem
Yaş: 39
İleti: 46
 
Cinsiyet: Bay
Bulunduğunuz İl / Semt: Elazığ


Forum Diğer Excel İşlemleri

Online Kullanıcılar

Bu forumu görüntüleyenler: Kayıtlı kullanıcı yok ve 1 misafir

Bumerang - Yazarkafe