Şart Bağlı veri alma

C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
328
Excel Vers. ve Dili
Excel 2010
Altın Üyelik Bitiş Tarihi
10-07-2026
Merhaba Ekte tabloda tarih koşulu oluşturarak ilgili sayfadan verileri getirmek istiyorum. Yardımlarınız için şimdiden teşekkür ederim
 

Ekli dosyalar

Ö

Ömer BARAN

Uzman
Katılım
8 Mart 2011
Mesajlar
12,997
Excel Vers. ve Dili
Office 2013 ( 32 bit ) TÜRKÇE
Altın Üyelik Bitiş Tarihi
(18.03.2020) - Uzman olduğu için tarih geçersiz oldu.
Merhaba.

Belgede mevcut verilere ve Sayfa2'deki ay seçimine göre olması gereken sonucu elle kopyala-yapıştır yaparak örneklendirmenizde yarar var.
Sayfalardaki başlıklar tam olarak aynı olmadığından, hangi sütun verisinin hangi sütuna aktarılacağını netleştirirseniz daha hızlı sonuca ulaşırsınız.
.
 
C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
328
Excel Vers. ve Dili
Excel 2010
Altın Üyelik Bitiş Tarihi
10-07-2026
Merhaba Ömer Bey

Alakanız için teşekkür ederim .

Ekte yer almaktadır.
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Kod: 
Sub aktar()

Set s1 = Sheets("2018")
Set s2 = Sheets("Sayfa2")

    s1.[B18].AutoFilter
    s1.[B18].AutoFilter

son = s1.Cells(Rows.Count, "C").End(3).Row
eskialacak = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "B").End(3).Row)
eskiborç = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "L").End(3).Row)
s2.Range("B9:I" & eskialacak).ClearContents
s2.Range("L9:S" & eskiborç).ClearContents

yeniborç = 9
yenialacak = 9

For i = 19 To son
    If s1.Cells(i, "C") = s2.[B2] Then
        If s1.Cells(i, "E") = "Alacak" Then
            s2.Cells(yenialacak, "B") = s1.Cells(i, "D")
            s2.Cells(yenialacak, "C") = s1.Cells(i, "G")
            s2.Cells(yenialacak, "D") = s1.Cells(i, "F")
            s2.Cells(yenialacak, "E") = s1.Cells(i, "H")
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yenialacak, "F") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yenialacak, "G") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yenialacak, "H") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yenialacak, "I") = s1.Cells(i, "I")
            yenialacak = yenialacak + 1
        ElseIf s1.Cells(i, "E") = "Borç" Then
            s2.Cells(yeniborç, "L") = s1.Cells(i, "D")
            s2.Cells(yeniborç, "M") = s1.Cells(i, "G")
            s2.Cells(yeniborç, "N") = s1.Cells(i, "F")
            s2.Cells(yeniborç, "O") = s1.Cells(i, "H")
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yeniborç, "P") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yeniborç, "Q") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yeniborç, "R") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yeniborç, "S") = s1.Cells(i, "I")
            yeniborç = yeniborç + 1
        End If
    End If
Next

End Sub
 
YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Eğer B2 değiştiğinde otomatik yüklenmesini istiyorsanız aşağıdaki kodları Sayfa2'nin kod bölümüne (sayfa ismine sağ tıklayıp kod Görüntüle deyince açılan sayfaya) yapıştırıp deneyin:
Kod: 
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Set s1 = Sheets("2018")
Set s2 = Sheets("Sayfa2")

    s1.[B18].AutoFilter
    s1.[B18].AutoFilter

son = s1.Cells(Rows.Count, "C").End(3).Row
eskialacak = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "B").End(3).Row)
eskiborç = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "L").End(3).Row)
s2.Range("B9:I" & eskialacak).ClearContents
s2.Range("L9:S" & eskiborç).ClearContents

yeniborç = 9
yenialacak = 9

For i = 19 To son
    If s1.Cells(i, "C") = s2.[B2] Then
        If s1.Cells(i, "E") = "Alacak" Then
            s2.Cells(yenialacak, "B") = s1.Cells(i, "D")
            s2.Cells(yenialacak, "C") = s1.Cells(i, "G")
            s2.Cells(yenialacak, "D") = s1.Cells(i, "F")
            s2.Cells(yenialacak, "E") = s1.Cells(i, "H")
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yenialacak, "F") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yenialacak, "G") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yenialacak, "H") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yenialacak, "I") = s1.Cells(i, "I")
            yenialacak = yenialacak + 1
        ElseIf s1.Cells(i, "E") = "Borç" Then
            s2.Cells(yeniborç, "L") = s1.Cells(i, "D")
            s2.Cells(yeniborç, "M") = s1.Cells(i, "G")
            s2.Cells(yeniborç, "N") = s1.Cells(i, "F")
            s2.Cells(yeniborç, "O") = s1.Cells(i, "H")
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yeniborç, "P") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yeniborç, "Q") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yeniborç, "R") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yeniborç, "S") = s1.Cells(i, "I")
            yeniborç = yeniborç + 1
        End If
    End If
Next

End Sub
 
C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
328
Excel Vers. ve Dili
Excel 2010
Altın Üyelik Bitiş Tarihi
10-07-2026
Arkadaşlar
Zihninize emeğinize sağlık
Çok teşekkür ederim
 
C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
328
Excel Vers. ve Dili
Excel 2010
Altın Üyelik Bitiş Tarihi
10-07-2026
Üstad Tekrardan Merhabalar

Tabloyu ekte ki gibi tekrar revize edebilir miyiz. Mümkünse tarih sıralamasına göre Uğraştım fakat beceremedim :)

Teşekkür ederim
 

Ekli dosyalar

YUSUF44

YUSUF44

Destek Ekibi
Destek Ekibi
Katılım
4 Ocak 2006
Mesajlar
12,073
Excel Vers. ve Dili
İş : Ofis 365 - Türkçe
Ev: Ofis 365 - Türkçe
Aşağıdaki kodları sayfa2'nin adına sağ tıklayıp kod görüntüle deyince açılan sayfaya yapıştırın. Öncesinde mevcut kodları silin:

Kod: 
If Intersect(Target, [B2]) Is Nothing Then Exit Sub
Set s1 = Sheets("2018")
Set s2 = Sheets("Sayfa2")

    s1.[B18].AutoFilter
    s1.[B18].AutoFilter

son = s1.Cells(Rows.Count, "C").End(3).Row

listesonu = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "B").End(3).Row)

s2.Range("B9:O" & listesonu).ClearContents

For i = 19 To son
    If s1.Cells(i, "C") = s2.[B2] Then 'dönem kontrolü
        yeni = WorksheetFunction.Max(9, s2.Cells(Rows.Count, "B").End(3).Row + 1) 'ilk boş satırı belirleme
        
        s2.Cells(yeni, "B") = s1.Cells(i, "D") 'tarih
        s2.Cells(yeni, "C") = s1.Cells(i, "G") 'açıklama
        s2.Cells(yeni, "D") = s1.Cells(i, "F") 'tür
        s2.Cells(yeni, "E") = s1.Cells(i, "H") 'evrak no
        
        If s1.Cells(i, "E") = "Alacak" Then
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yeni, "G") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yeni, "H") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yeni, "I") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yeni, "J") = s1.Cells(i, "I")
        ElseIf s1.Cells(i, "E") = "Borç" Then
            If s1.Cells(i, "J") = "TL" Then s2.Cells(yeni, "L") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "EURO" Then s2.Cells(yeni, "M") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "USD" Then s2.Cells(yeni, "N") = s1.Cells(i, "I")
            If s1.Cells(i, "J") = "STERLİN" Then s2.Cells(yeni, "O") = s1.Cells(i, "I")
        End If
    End If
Next
    
    bitiş = s2.Cells(Rows.Count, "B").End(3).Row

    s2.Sort.SortFields.Clear
    s2.Sort.SortFields.Add Key:=Range("B9:B" & bitiş) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    s2.Sort.SortFields.Add Key:=Range("E9:E" & bitiş) _
        , SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With s2.Sort
        .SetRange Range("B8:O" & bitiş)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    s2.Range("B9:B" & i).NumberFormat = "dd/mm/yyyy"
    With s2.Range("B9:B" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With s2.Range("E9:E" & i)
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With s2.Range("C9:D" & i)
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    With s2.Range("B9:O" & i)
        .VerticalAlignment = xlCenter
    End With
    
    s2.Range("G9:O" & i).NumberFormat = "#,##0.00"

    s2.Columns("B:E").EntireColumn.AutoFit
    s2.Columns("G:J").EntireColumn.AutoFit
    s2.Columns("L:O").EntireColumn.AutoFit
End Sub
 
C

ckarabacak

Altın Üye
Katılım
12 Ocak 2010
Mesajlar
328
Excel Vers. ve Dili
Excel 2010
Altın Üyelik Bitiş Tarihi
10-07-2026
Çok teşekkür ederim cevap yazdığınızdan beri uğraşıyorum bir türlü tutmadı gitti :) ilk yazdığınız kod ile karşılaştırınca neyi eksik yaptığımı gördüm eline sağlık üstadım
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst