• DİKKAT

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

Makro ile listeleme

M

Mehmet Sait

Altın Üye
Katılım
19 Ekim 2009
Mesajlar
840
Excel Vers. ve Dili
Office 2016 TR
Ekteki örnek tabloda makro ile listeleme yapmak istiyorum. Yardımlarınız için teşekkürler.
 

Ekli dosyalar

Ne yapılacak ? Biraz detay verin lütfen.
 
Murat OSMA' Alıntı:
Ne yapılacak ? Biraz detay verin lütfen.
Genişletmek için tıkla ...

Hocam,

İki ayrı sayfa mevcut. 1. Sayfada ayrı ayrı tablolar halinde. Diğer sayfada ise aldığımız çek ve senetlerin hem listesi hemde durumunu takip etmek istiyoruz. Her defasında "Takas Çekler - Portföy Çekler ve Takas Senetler - Portföy Senetler diye filtreleme yapmak yerine bir önceki sayfada var olan tablolara otomatik yazılması
listeden takas çekleri seçip önceki sayfada bulunan Takas Çekler tablosuna eklmesi diğer tablolar içinde aynı düzenleme yapmak istiyorum.

Tablo olan sayfada hücrelerde eğer formülü kullanılmış ancak doğruyu vermiyor.
 
Şu kodları deneyiniz;
Kod: 
Sub Emre()
    Dim i As Integer
    Application.ScreenUpdating = False
    a = 4: b = 16: c = 29: d = 39
    With Sayfa2
    For i = 4 To .Range("A65536").End(3).Row
        If .Cells(i, "E") Like "C*" And .Cells(i, "I") Like "P*" Then
            .Cells(i, 1).Resize(, 8).Copy
            Sayfa1.Cells(a, 1).PasteSpecial xlValue
            a = a + 1
        End If
        If .Cells(i, "E") Like "C*" And .Cells(i, "I") Like "TA*" Then
            .Cells(i, 1).Resize(, 8).Copy
            Sayfa1.Cells(b, 1).PasteSpecial xlValue
            b = b + 1
        End If
        If .Cells(i, "E") Like "S*" And .Cells(i, "I") Like "P*" Then
            .Cells(i, 1).Resize(, 8).Copy
            Sayfa1.Cells(c, 1).PasteSpecial xlValue
            c = c + 1
        End If
        If .Cells(i, "E") Like "S*" And .Cells(i, "I") Like "TA*" Then
            .Cells(i, 1).Resize(, 8).Copy
            Sayfa1.Cells(d, 1).PasteSpecial xlValue
            d = d + 1
        End If
    Next i
    End With
    i = Empty
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    MsgBox " ..::.. Liste Tamamlandı ..::.. ", vbInformation + vbMsgBoxRtlReading, Application.UserName
End Sub

Sub Temizle()
    Range("Osma").ClearContents
End Sub
Dosyanızı da yolluyorum...
Her ihtimale karşı kontrol ediniz...

İyi akşamlar...
 

Ekli dosyalar

Dunya_' Alıntı:
Hocam,

İki ayrı sayfa mevcut. 1. Sayfada ayrı ayrı tablolar halinde. Diğer sayfada ise aldığımız çek ve senetlerin hem listesi hemde durumunu takip etmek istiyoruz. Her defasında "Takas Çekler - Portföy Çekler ve Takas Senetler - Portföy Senetler diye filtreleme yapmak yerine bir önceki sayfada var olan tablolara otomatik yazılması
listeden takas çekleri seçip önceki sayfada bulunan Takas Çekler tablosuna eklmesi diğer tablolar içinde aynı düzenleme yapmak istiyorum.

Tablo olan sayfada hücrelerde eğer formülü kullanılmış ancak doğruyu vermiyor.
Genişletmek için tıkla ...

Merhaba
Alternatif Olsun
Bu kodu dener misiniz_?
Kod: 
Option Explicit
Sub kriterli_listele()
'Konu       :   Çek ve Senetleri Kritere Göre Listele
'Mail       :   m.batu.1967@gmail.com
'Msn        :   m.batu.1967@hotmail.com.tr
'Skype      :   m.batu.1967
'Coder By   :   asi_kral_1967
Dim s1 As Worksheet, s2 As Worksheet, yıldız As Long, _
a As Long, b As Long, c As Long, d As Long
Set s1 = Sheets("Genel Durum"): Set s2 = Sheets("LİSTE")
Application.ScreenUpdating = False
s1.Range("A4:H10").ClearContents
s1.Range("A16:H24").ClearContents
s1.Range("A29:H33").ClearContents
s1.Range("A39:H45").ClearContents
a = 4: b = 16: c = 29: d = 39
For yıldız = 4 To s2.Range("B" & Rows.Count).End(xlUp).Row
With WorksheetFunction
If .Proper(s2.Cells(yıldız, "E")) = "Cek" And .Proper(s2.Cells(yıldız, "G")) = "Portföy" Then
If a < 11 Then
s1.Cells(a, "A") = a - 3: s1.Cells(a, "B") = s2.Cells(yıldız, "B")
s1.Cells(a, "C") = s2.Cells(yıldız, "C"): s1.Cells(a, "D") = s2.Cells(yıldız, "D")
s1.Cells(a, "E") = s2.Cells(yıldız, "E"): s1.Cells(a, "F") = s2.Cells(yıldız, "F")
s1.Cells(a, "G") = s2.Cells(yıldız, "H"): s1.Cells(a, "H") = s2.Cells(yıldız, "I")
a = a + 1: End If
ElseIf .Proper(s2.Cells(yıldız, "E")) = "Cek" And .Proper(s2.Cells(yıldız, "G")) = "Takas" Then
If b < 25 Then
s1.Cells(b, "A") = b - 15: s1.Cells(b, "B") = s2.Cells(yıldız, "B")
s1.Cells(b, "C") = s2.Cells(yıldız, "C"): s1.Cells(b, "D") = s2.Cells(yıldız, "D")
s1.Cells(b, "E") = s2.Cells(yıldız, "E"): s1.Cells(b, "F") = s2.Cells(yıldız, "F")
s1.Cells(b, "G") = s2.Cells(yıldız, "H"): s1.Cells(b, "H") = s2.Cells(yıldız, "I")
b = b + 1: End If
ElseIf .Proper(s2.Cells(yıldız, "E")) = "Senet" And .Proper(s2.Cells(yıldız, "G")) = "Portföy" Then
If c < 34 Then
s1.Cells(c, "A") = c - 28: s1.Cells(c, "B") = s2.Cells(yıldız, "B")
s1.Cells(c, "C") = s2.Cells(yıldız, "C"): s1.Cells(c, "D") = s2.Cells(yıldız, "D")
s1.Cells(c, "E") = s2.Cells(yıldız, "E"): s1.Cells(c, "F") = s2.Cells(yıldız, "F")
s1.Cells(c, "G") = s2.Cells(yıldız, "H"): s1.Cells(c, "H") = s2.Cells(yıldız, "I")
c = c + 1: End If
ElseIf .Proper(s2.Cells(yıldız, "E")) = "Senet" And .Proper(s2.Cells(yıldız, "G")) = "Takas" Then
If d < 46 Then
s1.Cells(d, "A") = d - 38: s1.Cells(d, "B") = s2.Cells(yıldız, "B")
s1.Cells(d, "C") = s2.Cells(yıldız, "C"): s1.Cells(d, "D") = s2.Cells(yıldız, "D")
s1.Cells(d, "E") = s2.Cells(yıldız, "E"): s1.Cells(d, "F") = s2.Cells(yıldız, "F")
s1.Cells(d, "G") = s2.Cells(yıldız, "H"): s1.Cells(d, "H") = s2.Cells(yıldız, "I")
d = d + 1: End If: End If: End With: Next
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlandı" & vbLf & Application.UserName, _
vbInformation, "asi_kral_1967"
End Sub
Dosyanız Ekte.
 

Ekli dosyalar

Sayın Murat Osma ve Asi_Kral_1967

Yardım ve uğraşınız için teşekkür ederim. Her iki çalışmada çok güzel olmuş. Liste kısmında hareketler çoğaldıkça ilgili tabloda satır eklemesi yapmıyor.
 
Sayın Murat Osma ve sayın asi kral 1967 çok teşekkürler, elinize emeğinize sağlık.
 
Sağolun Serdar Bey... :)

İyi günler...
 
Dunya_' Alıntı:
Sayın Murat Osma ve Asi_Kral_1967

Yardım ve uğraşınız için teşekkür ederim. Her iki çalışmada çok güzel olmuş. Liste kısmında hareketler çoğaldıkça ilgili tabloda satır eklemesi yapmıyor.
Genişletmek için tıkla ...

Evet yapmaz çünkü siz böyle bir ifade kullanmadınız bizde sabit olduğunu varsaymıştık. Bu değişecek ise tabloyu ona göre düzenlemek gerekecektir. Gerekirse tüm tabloyu makro yaptırmak gerekebilir.
 
asi_kral_1967' Alıntı:
Evet yapmaz çünkü siz böyle bir ifade kullanmadınız bizde sabit olduğunu varsaymıştık. Bu değişecek ise tabloyu ona göre düzenlemek gerekecektir. Gerekirse tüm tabloyu makro yaptırmak gerekebilir.
Genişletmek için tıkla ...

Sayın Murat Osma ve Asi_Kral_1967

Hocam,

Sizin verdiğiniz mantıkla yola çıkarak dosyayı biraz daha geliştirdim güzel bir çalışma oldu çek/senet takibi yapmak isteyen arkadaşlar kullanabilirler.
Dilerseniz dosyanın son halini ekleyebilirim.
 
Dunya_' Alıntı:
Sayın Murat Osma ve Asi_Kral_1967

Hocam,

Sizin verdiğiniz mantıkla yola çıkarak dosyayı biraz daha geliştirdim güzel bir çalışma oldu çek/senet takibi yapmak isteyen arkadaşlar kullanabilirler.
Dilerseniz dosyanın son halini ekleyebilirim.
Genişletmek için tıkla ...

Karar sizin siz paylaşmak isterseniz paylaşabilirsiniz.
 
Bence yeni form güzel olmuş. Ama eskisi de güzeldi.. :D
Eski formda; üç aşağı beş yukarı en fazla kaç çek, senet vs. girişi yapıladığı bellidir, ona göre satırları ayarlayıp, hepsini bir sayfada yazdırılması iyi olurdu..

Yeni formda da; yazdırılmak istendiğinde, her tablo ayrı sayfalarda yazdırılabilecek şekilde ayarlanırsa daha iyi olur...

İşinizi tam olarak bilmediğimden âfâki yorumlar yapıyorum. Siz daha iyi bilirsiniz... :)

İyi günler...
 
Murat OSMA' Alıntı:
Bence yeni form güzel olmuş. Ama eskisi de güzeldi.. :D
Eski formda; üç aşağı beş yukarı en fazla kaç çek, senet vs. girişi yapıladığı bellidir, ona göre satırları ayarlayıp, hepsini bir sayfada yazdırılması iyi olurdu..

Yeni formda da; yazdırılmak istendiğinde,
Murat OSMA' Alıntı:
Bence yeni form güzel olmuş. Ama eskisi de güzeldi.. :D
Eski formda; üç aşağı beş yukarı en fazla kaç çek, senet vs. girişi yapıladığı bellidir, ona göre satırları ayarlayıp, hepsini bir sayfada yazdırılması iyi olurdu..

Yeni formda da; yazdırılmak istendiğinde, her tablo ayrı sayfalarda yazdırılabilecek şekilde ayarlanırsa daha iyi olur...

İşinizi tam olarak bilmediğimden âfâki yorumlar yapıyorum. Siz daha iyi bilirsiniz... :)

İyi günler...
Genişletmek için tıkla ...



İşinizi tam olarak bilmediğimden âfâki yorumlar yapıyorum. Siz daha iyi bilirsiniz... :)

İyi günler...
Genişletmek için tıkla ...


Eski form elbette güzel çünkü mantığın merkezi. Hocam yazdırma işi ile uğraştım ama yapamadım sizinde deiğiniz gibi " her tablo ayrı sayfalarda yazdırılabilecek şekilde ayarlanırsa daha iyi olur... " her tabloyu ayrı ayrı nasıl yazdırabilirim eklenecek kod varmı acaba

ve "Genel Durum " Sayfasında en altta yada yanına aynı tarihte olan çek ve senetlerin toplamını alabilirmiyiz ?

Yardım ve uğraşınızdan dolayı çok teşekkür ederim.
 
Sütun genişlikleri ile oynayarak yapabilirsiniz... İlk tablonun ayarları ile aynı yapın..
 
Az önce yoğundum istediğinizi yapacak vaktim yoktu. Bu nedenle sizin yapmanızı istedim.

Şimdi tabloların her birini ayrı sayfada yazdıracak şekilde ayarladım..

Bakınız:
 

Ekli dosyalar

Teşekkür ederim Hocam eline sağlık güzel olmuş

Diğer konu mümkün mü acaba

"Genel Durum " Sayfasında en altta yada tablonun yanına aynı tarihte olan çek ve senetlerin toplamını alabilirmiyiz ?
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst