İki tarih arasını sayfalardan aktarma

Ahmet Sami · 28 Nisan 2023

İyi günler kıymetli abilerim gönderdiğim örnek dosyada bulunan herhangi İki Tarih Arasındaki Bilgilerin Mevcut Bulunan "Gider, Fatura, Muhtelif" Sayfalarından "Aktar" Sayfasına Aktarılması Gerekiyor yardımlarınız için şimdiden teşekkür ederim.

veyselemre · 28 Nisan 2023

Kod:

Sub aktar()
    Dim rs As Object, con$, strSQL$, tar1, tar2

    Sheets("AKTAR").Range("2:" & Rows.Count).ClearContents
    Set rs = CreateObject("ADODB.Recordset")

    tar1 = Replace(Format(Sheets("ANASAYFA").Range("H9").Value, "mm/dd/yyyy"), ".", "/")
    tar2 = Replace(Format(Sheets("ANASAYFA").Range("H10").Value, "mm/dd/yyyy"), ".", "/")

    con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & ThisWorkbook.FullName & _
          ";Extended Properties=""Excel 12.0;Hdr=YES"""

    strSQL = "SELECT * FROM " & _
             "( SELECT * FROM [FATURA$] UNION ALL " & _
             "  SELECT * FROM [MUHTELİF$] UNION ALL " & _
             "  SELECT * FROM [GİDER$] ) WHERE TARİH >=#" & _
             tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"

    rs.Open strSQL, con, 1, 1

    Sheets("AKTAR").Range("A2").CopyFromRecordset rs

    rs.Close
End Sub

Ahmet Sami · 28 Nisan 2023

Veysel bey çok teşekkür ederim. Sağolun.

Ahmet Sami · 28 Nisan 2023

"( SELECT * FROM [FİRMA ÖDEME$] UNION ALL " & _
" SELECT * FROM [KİŞİ ÖDEME$] UNION ALL " & _
" SELECT * FROM [MAAŞ PRİM$] UNION ALL " & _
" SELECT * FROM [GİDER$] ) WHERE TARİH >=#" & _
tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"
Veysel bey sizi yoruyorum ama kusuruma bakmayın sayfa ismi değiştirince kod
rs.Open strSQL, con, 1, 1
burda hata veriyor

veyselemre · 28 Nisan 2023

Hata gözükmüyor, örnek ekleyin.

Ahmet Sami · 1 Mayıs 2023

Veysel bey normalde sayfalar gizli yani tarih olarak verileri gizli olan sayfalardan alıyor ondan dolayı bir sıkıntı olabilir mi

tahsinanarat · 1 Mayıs 2023

ceraeen' Alıntı:
baya uzun süre sonra yazıyorum ama bana bu dosya lazım yardımcı olma şansınız var mı ?

Ahmet Sami' Alıntı:
"( SELECT * FROM [FİRMA ÖDEME$] UNION ALL " & _
" SELECT * FROM [KİŞİ ÖDEME$] UNION ALL " & _
" SELECT * FROM [MAAŞ PRİM$] UNION ALL " & _
" SELECT * FROM [GİDER$] ) WHERE TARİH >=#" & _
tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"
Veysel bey sizi yoruyorum ama kusuruma bakmayın sayfa ismi değiştirince kod
rs.Open strSQL, con, 1, 1
burda hata veriyor

Sn. Ahmet Sami Bey; Değiştirdiğiniz sayfa isminin kod içinde de değiştirmeniz gerekiyor, acep bunu mu atlıyorsunuz.

Ahmet Sami · 3 Mayıs 2023

Tahsin bey evet aynı şekilde hem sayfa hemde kod içerisinde değiştiriyorum.

dost · 3 Mayıs 2023

Merhaba,

Aşağıdaki şekilde kullanabilirsiniz.

C++:

Sub aktar()
    Dim rs As Object, con$, strSQL$, tar1, tar2
    Dim s1Name, s2Name, s3Name As String

    Sheets("AKTAR").Range("2:" & Rows.Count).ClearContents
    Set rs = CreateObject("ADODB.Recordset")
   
    s1Name = Sheet1.Name
    s2Name = Sheet2.Name
    s3Name = Sheet3.Name

    tar1 = Replace(Format(Sheets("ANASAYFA").Range("H9").Value, "mm/dd/yyyy"), ".", "/")
    tar2 = Replace(Format(Sheets("ANASAYFA").Range("H10").Value, "mm/dd/yyyy"), ".", "/")

    con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & ThisWorkbook.FullName & _
          ";Extended Properties=""Excel 12.0;Hdr=YES"""

    strSQL = "SELECT * FROM " & _
             "( SELECT * FROM [" & s1Name & "$] UNION ALL " & _
             "  SELECT * FROM [" & s2Name & "$] UNION ALL " & _
             "  SELECT * FROM [" & s3Name & "$] ) WHERE TARİH >=#" & _
             tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"

     rs.Open strSQL, con, 1, 1

    Sheets("AKTAR").Range("A2").CopyFromRecordset rs

    rs.Close
End Sub

Ahmet Sami · 3 Mayıs 2023

Dosyam ektedir. Sayın dost uyguladım ama yinede hata verdi.

dost · 3 Mayıs 2023

Merhaba,

Sorun sayfa başlıklarının 2.satırdan başlamış olması.

Kodu revize ettim. Sizin göndermiş olduğunuz dosyada çalıştı.

C++:

Sub aktar()
    Dim rs As Object, con$, strSQL$, tar1, tar2
    Dim s1Name, s2Name, s3Name As String
    'Referance: Microsoft ActiveX data Object xxx Library

    Sheets("AKTAR").Range("2:" & Rows.Count).ClearContents
    Set rs = CreateObject("ADODB.Recordset")
    
    s1Name = "FİRMA ÖDEME"
    s2Name = "KİŞİ ÖDEME"
    s3Name = "GİDER"
    
 
    tar1 = Replace(Format(Sheets("ANASAYFA").Range("H9").Value, "mm/dd/yyyy"), ".", "/")
    tar2 = Replace(Format(Sheets("ANASAYFA").Range("H10").Value, "mm/dd/yyyy"), ".", "/")

    con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & ThisWorkbook.FullName & _
          ";Extended Properties=""Excel 12.0;Hdr=YES"""

    strSQL = "SELECT * FROM " & _
             "( SELECT * FROM [" & s1Name & "$A2:J] UNION ALL " & _
             "  SELECT * FROM [" & s2Name & "$A2:J] UNION ALL " & _
             "  SELECT * FROM [" & s3Name & "$A2:J] ) WHERE TARİH >=#" & _
             tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"

   
    rs.Open strSQL, con, 1, 1

    Sheets("AKTAR").Range("A2").CopyFromRecordset rs

    rs.Close
    Set rs = Nothing
End Sub

Ahmet Sami · 4 Mayıs 2023

Teşekkür ederim. Emeğinize elinize sağlık

dost · 4 Mayıs 2023

Merhaba,

Ben kodda ufak bir değişiklik yaptım. Teşekkürü hak eden @veyselemre dir.

İyi çalışmalar.

Ahmet Sami · 5 Mayıs 2023

Emeği geçen tüm üstadlarımıza teşekkür ederim.
Sayın dost gününüz hayır olsun,
Sizden bir istirhamım daha olacak aktarma işlemi tamam ama TL Dolar ve Euro sütunlarını aktarırken metin olarak aktardığı için AKTAR sayfasında toplam alamıyorum. Onu nasıl yapabilirim

dost · 5 Mayıs 2023

Merhaba,

C++:

Sub aktar()
    Dim rs As Object, con$, strSQL$, tar1, tar2
    Dim s1Name, s2Name, s3Name As String
    Dim lRow As Long, col As Byte
    Dim sumRng
    'Referance: Microsoft ActiveX data Object xxx Library

    Sheets("AKTAR").Range("2:" & Rows.Count).ClearContents
    Set rs = CreateObject("ADODB.Recordset")
    
    s1Name = "FİRMA ÖDEME"
    s2Name = "KİŞİ ÖDEME"
    s3Name = "GİDER"
    Sheets("AKTAR").Cells.Font.Bold = False
    Sheets("AKTAR").Columns("G:I").NumberFormat = "#,##0.00"
 
    tar1 = Replace(Format(Sheets("ANASAYFA").Range("H9").Value, "mm/dd/yyyy"), ".", "/")
    tar2 = Replace(Format(Sheets("ANASAYFA").Range("H10").Value, "mm/dd/yyyy"), ".", "/")

    con = "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & ThisWorkbook.FullName & _
          ";Extended Properties=""Excel 12.0;Hdr=YES"""

    strSQL = "SELECT * FROM " & _
             "( SELECT * FROM [" & s1Name & "$A2:J] UNION ALL " & _
             "  SELECT * FROM [" & s2Name & "$A2:J] UNION ALL " & _
             "  SELECT * FROM [" & s3Name & "$A2:J] ) WHERE TARİH >=#" & _
             tar1 & "# AND TARİH <=#" & tar2 & "# ORDER BY TARİH"

  
    rs.Open strSQL, con, 1, 1

    Sheets("AKTAR").Range("A2").CopyFromRecordset rs
    lRow = Sheets("AKTAR").Cells(Rows.Count, 1).End(xlUp).Row
    
    For col = 7 To 9
        sumRng = Sheets("AKTAR").Range(Sheets("AKTAR").Cells(2, col), Sheets("AKTAR").Cells(lRow, col))
        Sheets("AKTAR").Cells(lRow + 1, col) = Application.WorksheetFunction.Sum(sumRng)
    Next col
    
    Sheets("AKTAR").Cells(lRow + 1, "F") = "Toplam"
    Sheets("AKTAR").Cells(lRow + 1, 1).EntireRow.Font.Bold = True

    rs.Close
    Set rs = Nothing
    MsgBox "Veriler AKTAR sayfasına aktarılmıştır..."
    
    Worksheets("AKTAR").Visible = True
    Worksheets("AKTAR").Activate
    Sheets("AKTAR").Range("A1").Select
    
End Sub

Ahmet Sami · 5 Mayıs 2023

Üstadım yine metin hücresi olarak atıyor ve toplama yapmıyor. Ancak hücrenin içerisine girip çıkarsam toplama yapıyor.

dost · 5 Mayıs 2023

Excel dosyanızı tekrar ekler misiniz.

Ahmet Sami · 9 Mayıs 2023

Buyurun sayın dost. Kusurumuza bakmayın rahatsızdım bir kaç gün yattım size dönemedim.

dost · 9 Mayıs 2023

Merhaba,

Göndermiş olduğunuz dosyaya kodu kopyaladım.
Sorunsuz çalıştı.

Dosya ektedir.

Ahmet Sami · 10 Mayıs 2023

Çok teşekkür ederim. Hakkınızı helal edin sizi yordum sağolun

İki tarih arasını sayfalardan aktarma

Ahmet Sami

Ekli dosyalar

veyselemre

Özel Üye

Ahmet Sami

Ahmet Sami

veyselemre

Özel Üye

Ahmet Sami

tahsinanarat

Ahmet Sami

dost

Ahmet Sami

Ekli dosyalar

dost

Ahmet Sami

dost

Ahmet Sami

dost

Ahmet Sami

dost

Ahmet Sami

Ekli dosyalar

dost

Ekli dosyalar

Ahmet Sami