Veri Tabanındaki verilerim otomatik olarak ilgili sayfalara nasıl aktarılır?

Baturfurkan · 24 Nisan 2021

Öncelikle herkese iyi günler diler, geçmiş 23 Nisan Ulusal Egemenlik ve Çocuk Bayramınızı kutlarım. Şöyle bir sorunum var:
"Veri" isminde bir excel sayfam var (bknz.1.jpg) ve 22 sütundan satır uzunluğu sürekli artan verilerim var. Veri tabanı olarak kullanmaktayım.
1. Sütunum mükerrer etmeyen sıra numaralarından oluşuyor.
2. Sütunum mükerrer edebilen kuyruk numaralarından oluşuyor.
3. Sütun da aynı şekilde gövde numaralarından oluşuyor.
Benim ihtiyacım olan şey Veri Tabanındaki 3. Sütunumda yazan Kuyruk Numarasında yazana göre o bilgisini kopyalayıp aynı kuyruk numara isimli (bknz.1.jpg en alt) sayfaya alt alta yapıştırması. Bilgi olarak vereyim sadece 3 adet kuyruk numarası ve 3 adet sayfa var. 3. satırda yani C satırında AK27 yazıyorsa o satırdaki kopyalayıp AK27'ye yapıştırması.
Ben bu işlem için önce filtreleyip kopyalayan ve işlemi 3 kez tekrar eden bir makro kaydettim ve tuşa bağladım, ve formülü verdim. Ama acaba otomatik yapılması yada daha temiz bir kod yada tavsiye varsa diye sizlere danışmak istedim. Şimdiden teşekkür ederim.

[KOD] Sayfalar ("AK13 Uçuş") Seçiniz
Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Selection.Delete Shift: = xlUp

E-Tablolar ("Veri"). Seçin
Satırlar ("1: 1"). Seçin
Selection.AutoFilter
ActiveSheet.Range ("$ A $ 1: $ V $ 1"). Otomatik Filtre Alanı: = 3, Ölçüt1: = "AK13"

Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Seçim Kopyala

E-Tablolar ("AK13 Uçuş").
Aralık ("A1"). Seçin
ActiveSheet.Paste

ActiveWindow.Zoom = 86
Sütunlar ("A: V"). Seçin
Aralık ("V1"). Etkinleştir
Sütunlar ("A: V"). EntireColumn.AutoFit
Aralık ("A1"). Seçin

E-Tablolar ("Veri"). Seçin
Satırlar ("1: 1"). Seçin
Application.CutCopyMode = Yanlış
Selection.AutoFilter

E-Tablolar ("AK14 Uçuş").
Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Selection.Delete Shift: = xlUp
E-Tablolar ("Veri"). Seçin

Satırlar ("1: 1"). Seçin
Selection.AutoFilter
ActiveSheet.Range ("$ A $ 1: $ V $ 1"). Otomatik Filtre Alanı: = 3, Ölçüt1: = "AK14"

Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Seçim Kopyala

E-Tablolar ("AK14 Uçuş").
Aralık ("A1"). Seçin
ActiveSheet.Paste

ActiveWindow.Zoom = 86
Sütunlar ("A: V"). Seçin
Aralık ("V1"). Etkinleştir
Sütunlar ("A: V"). EntireColumn.AutoFit
Aralık ("A1"). Seçin

E-Tablolar ("Veri"). Seçin
Satırlar ("1: 1"). Seçin
Application.CutCopyMode = Yanlış
Selection.AutoFilter

E-Tablolar ("AK15 Uçuş").
Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Selection.Delete Shift: = xlUp
E-Tablolar ("Veri"). Seçin

Satırlar ("1: 1"). Seçin
Selection.AutoFilter
ActiveSheet.Range ("$ A $ 1: $ V $ 1"). Otomatik Filtre Alanı: = 3, Ölçüt1: = "AK15"

Aralık ("A1"). Seçin
Aralık (Seçim, Seçim Sonu (xlToRight)).
Aralık (Seçim, Seçim Sonu (xlDown)). Seçin
Seçim Kopyala

E-Tablolar ("AK15 Uçuş").
Aralık ("A1"). Seçin
ActiveSheet.Paste

ActiveWindow.Zoom = 86
Sütunlar ("A: V"). Seçin
Aralık ("V1"). Etkinleştir
Sütunlar ("A: V"). EntireColumn.AutoFit
Aralık ("A1"). Seçin

E-Tablolar ("Veri"). Seçin
Satırlar ("1: 1"). Seçin
Application.CutCopyMode = Yanlış
Selection.AutoFilter

E-Tablolar ("Veri"). Seçin
Aralık ("A1"). Seçin

Son Abone [/ CODE]

[MEDIA = imgur] Tcw53eK [/ MEDIA]

Baturfurkan · 24 Nisan 2021

Bununla ilgili olarak işime yarayacak çok güzel bir formül bulmuştum aslında, ama sadece microsoft 365'Te geçerli olduğu için kullanamadım. Filtre formülü;

FİLTRE işlevi - Microsoft Desteği

Excel’de veri aralıklarını tanımladığınız ölçütlere göre filtrelemenize yarayan FİLTRE işlevini kullanma.

support.microsoft.com

Baturfurkan · 24 Nisan 2021

Kusura bakmayın gece iş çıkışı yazmıştım ve biraz karışık yazdığımı, kendimi tam ifade edemediğimi fark ettim. Umarım şu an açıklayabilirim. "Veri", "Ali", "Mehmet", "Salih" adında 4 adet sayfam var. Tüm veri girişi "Veri" sayfasına yapılıyor. Benim istediğim ise "Veri" sayfasındaki 3. Yani C sütunundaki hücrede Ali yazıyorsa o satır komple "Ali" sayfasına kopyalansın. Hücrede "Mehmet" yazıyorsa o satır komple "Mehmet" sayfasına kopyalansın. Böylece ben tüm verilerimi "Veri" sayfasında görebiliyorken, "Ali" sayfasına geçtiğimde sadece 3. Sütununda "Ali" yazan verileri göreceğim. Peki ben şimdilik bunu nasıl yapıyorum. ;
Bir makro kaydettim ve tuşa atadım. Veri sayfasına filtre atıyor, ali olanları gösterip diğerlerini gizliyor. Görünür tüm satırları kopyalayıp Ali sayfasına yapıştırıyor. Sonra bunu teker teker Mehmet ve Salih sayfaları içinde yapıyor. Bu işlem tuşa bağlı olduğu için ve birde uzun birbirini tekrar eden işlemler olduğu için acaba başka bir yolu var mıdır diye öğrenmek istedim. Şimdiden teşekkür ederim.

ÖmerFaruk · 24 Nisan 2021

Forumda ADO örnekleri bolca mevcut. O örneklere bakarak rahatlıkla
Basit bir sorgu cümlesiyle yapabilirsiniz
Eğer yapamam diyorsanız yine yardımcı olalım.

ÖmerFaruk · 24 Nisan 2021

Aşağıdaki kodları her çalıştırdığınızda Veri sayfanızdaki A2:Vxxxx aralığındaki verileri C sütunundaki diğer üç sayfanın adını taşıyan değerlere göre ilgili sayfalara aktarır.
Dosyada Veri sayfanızdaki verileri TblVeri olarak tanımladım.

Örnek dosyayı da ekledim.

C++:

Sub SayfalaraAktar_ADO()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myQuery As String
Dim myTable As String

    myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Con.Open "provider=microsoft.ace.oledb.12.0;" & "data source = " & ThisWorkbook.FullName & ";" & "extended properties=""excel 12.0;hdr=Yes"""
    
    For i = 1 To Worksheets.Count
    Select Case Worksheets(i).Name
        Case "Ali", "Salih", "Mehmet"
        Sh = Worksheets(i).Name
        Worksheets(i).Cells.ClearContents
        myQuery = "Select * from [" & myTable & "] Where [Başlık3]= '" & Sh & "'"
        Rs.Open myQuery, Con, 1, 1
        x = 1
        For Each AlanAdı In Rs.Fields
            Worksheets(i).Cells(1, x) = AlanAdı.Name
            x = x + 1
        Next AlanAdı
        If Rs.RecordCount > 0 Then Worksheets(i).Range("A2").CopyFromRecordset Rs
        Rs.Close
        Case Else
            GoTo Devam
    End Select
Devam:
    Next i
    myQuery = vbNullString: SorguWhere = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

Baturfurkan · 25 Nisan 2021

Çok teşekkür ederim yardımınız için, elimden geldiğince örnekleri de inceleyerek ADO konusunda öğrenmeye çalışacağım. İki sorum var acaba A2:V... aralığındaki verileri değilde mesela A2:Z... aralığında ki verileri aldırmak istersem neyi değiştirmem lazım acaba?
Birde şöyle bir hata alıyorum;
---> myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
Run-Time error '9':
Subscript out of range

Baturfurkan · 25 Nisan 2021

Tamamdır o hatayı düzelttim tablonun ismini tam olarak "TblVeri" olarak tanımlamamışım. Şimdi şöyle bir hata ile karşılaştım;
Gerek bir veya birden fazla değer için girilen değer yok.
--->Rs.Open myQuery, Con, 1, 1

Baturfurkan · 25 Nisan 2021

@NextLevel birkaç saattir farklı metodlar deniyorum. Sanırım veri sayfasındaki tabloda bir şeyi eksik yapıyorum. Sizin örnek olarak eklediğiniz excel dosyasında ki verileri ve vba ki kodları değiştirip kullandığımda bir sorun olmuyor. Ama ben birebir aynı tabloyu aynı verileri oluşturup kodu kullandığımda "Gerekli bir veya birden fazla değer için girilen değeri yok hatası alıyorum." Acaba nerede hata yapıyor olabilirim?

ÖmerFaruk · 25 Nisan 2021

myQuery = "Select * from [" & myTable & "] Where [Başlık3]= '" & Sh & "'"

C sütununuza verdiğiniz Alan Etiketi ne ise onu Başlık3 yerine yazın

Baturfurkan · 28 Nisan 2021

NextLevel' Alıntı:
myQuery = "Select * from [" & myTable & "] Where [Başlık3]= '" & Sh & "'"

C sütununuza verdiğiniz Alan Etiketi ne ise onu Başlık3 yerine yazın

@NextLevel Teşekkür ederim, şimdi de şöyle sorunlar çıktı, veri sayfasında ki saatleri kopyalarken bozuyor. Örneğin veri sayfamda hücrede (10:00) yazıyorsa hem veri sayfasında ki hem kopyaladığı ali sayfasındaki hücreye (0,41666666667) yazıyor. Birde, ali salih ve mehmet sayfalarının başlıklarını farklı yapamıyorum her formülü kullanışımda veri sayfasının başlığı aktarıyor o konuda bir şey yapabilir miyiz?
Çalışma dosyamı da aynen ekledim incelemek isterseniz eğer;
çalışma dosyam

ÖmerFaruk · 28 Nisan 2021

C++:

Sub SayfalaraAktar_ADO()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myQuery As String
Dim myTable As String
Dim Sh As String

    myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Con.Open "provider=microsoft.ace.oledb.12.0;" & "data source = " & ThisWorkbook.FullName & ";" & "extended properties=""excel 12.0;hdr=Yes"""
    
    For i = 1 To Worksheets.Count
    Select Case Worksheets(i).Name
        Case "Em321", "Em322", "Em323"
        Sh = Worksheets(i).Name
        Worksheets(Sh).Cells.ClearContents
        myQuery = "Select * from [" & myTable & "] Where [Emn No]= '" & UCase(Sh) & "'"
        Rs.Open myQuery, Con, 1, 1
        If Rs.RecordCount > 0 Then
            Worksheets(Sh).Range("A2").CopyFromRecordset Rs
            Worksheets(Sh).Range("E:E,G:G").NumberFormat = "hh:mm;@"
        End If
        Rs.Close
        Case Else
            GoTo Devam
    End Select
Devam:
    Next i
    Sheets("Veri").Range("E:E,G:G").NumberFormat = "hh:mm;@"
    myQuery = vbNullString: SorguWhere = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

Baturfurkan · 28 Nisan 2021

NextLevel' Alıntı:

C++:

Sub SayfalaraAktar_ADO()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myQuery As String
Dim myTable As String
Dim Sh As String

    myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Con.Open "provider=microsoft.ace.oledb.12.0;" & "data source = " & ThisWorkbook.FullName & ";" & "extended properties=""excel 12.0;hdr=Yes"""
   
    For i = 1 To Worksheets.Count
    Select Case Worksheets(i).Name
        Case "Em321", "Em322", "Em323"
        Sh = Worksheets(i).Name
        Worksheets(Sh).Cells.ClearContents
        myQuery = "Select * from [" & myTable & "] Where [Emn No]= '" & UCase(Sh) & "'"
        Rs.Open myQuery, Con, 1, 1
        If Rs.RecordCount > 0 Then
            Worksheets(Sh).Range("A2").CopyFromRecordset Rs
            Worksheets(Sh).Range("E:E,G:G").NumberFormat = "hh:mm;@"
        End If
        Rs.Close
        Case Else
            GoTo Devam
    End Select
Devam:
    Next i
    Sheets("Veri").Range("E:E,G:G").NumberFormat = "hh:mm;@"
    myQuery = vbNullString: SorguWhere = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

Kusura bakmayın sizi biraz uğraştırdım. Ve yardımlarınız içinde çok teşekkür ederim. Şimdi sadece iki sorunum kaldı, yardımcı olabilirseniz çok sevinirim.
1- Formül sorunsuz çalışıyor ama Em321 -Em322 - Em323 sayfalarının ilk satırında yer alan başlıklar siliniyor. Ve bomboş kalıyor. Bunu engelleyebilir miyiz? Benim başlıklarım hep standart, yer değişikliği de olmayacak. Yani silmesine yada yeniden kopyalamasına gerek yok.
2- Şu anda A sütunu ile V sütunu arasında ki verileri taşıyor. İlerde gerek duyarsam eğer V sütunu yerine örneğin M sütununa kadar verileri almak istersen nereyi değiştirmem gerekir?

Tekrardan yardımlarınız ve ilginiz için çok teşekkür ederim @NextLevel

ÖmerFaruk · 28 Nisan 2021

C#:

Sub SayfalaraAktar_ADO()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myQuery As String
Dim myTable As String

'Eğer Veri sayfanızdaki aralığı benim yaptığım gibi "TblVeri" adıyla Tablo olarak eklemişseniz
'Tablonun üzerinde Aralığı Yeniden Boyutlandır diyerek istediğiniz sütuna kadar işlem yaptırabilirsiniz.

    myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Con.Open "provider=microsoft.ace.oledb.12.0;" & "data source = " & ThisWorkbook.FullName & ";" & "extended properties=""excel 12.0;hdr=Yes"""
    For i = 1 To Worksheets.Count
        Select Case Worksheets(i).Name
            Case "Em321", "Em322", "Em323"
            Sh = Worksheets(i).Name
            myQuery = "Select * from [" & myTable & "] Where [Emn No]= '" & UCase(Sh) & "'"
            Rs.Open myQuery, Con, 1, 1
            If Rs.RecordCount > 0 Then
                Worksheets(Sh).Range("A2:V" & Worksheets(Sh).Range("A" & Rows.Count).End(xlUp).Row).ClearContents
                Worksheets(Sh).Range("A2").CopyFromRecordset Rs
                Worksheets(Sh).Range("E:E,G:G").NumberFormat = "hh:mm;@"
            End If
            Rs.Close
            Case Else
        End Select
    Next i
    Sheets("Veri").Range("E:E,G:G").NumberFormat = "hh:mm;@"
    myQuery = vbNullString: SorguWhere = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

Baturfurkan · 30 Nisan 2021

NextLevel' Alıntı:

C#:

Sub SayfalaraAktar_ADO()
Dim Con As ADODB.Connection
Dim Rs As ADODB.Recordset
Dim myQuery As String
Dim myTable As String

'Eğer Veri sayfanızdaki aralığı benim yaptığım gibi "TblVeri" adıyla Tablo olarak eklemişseniz
'Tablonun üzerinde Aralığı Yeniden Boyutlandır diyerek istediğiniz sütuna kadar işlem yaptırabilirsiniz.

    myTable = "Veri$" & Sheets("Veri").ListObjects("TblVeri").Range.Address(False, False)
    Set Con = New ADODB.Connection
    Set Rs = New ADODB.Recordset
    Con.Open "provider=microsoft.ace.oledb.12.0;" & "data source = " & ThisWorkbook.FullName & ";" & "extended properties=""excel 12.0;hdr=Yes"""
    For i = 1 To Worksheets.Count
        Select Case Worksheets(i).Name
            Case "Em321", "Em322", "Em323"
            Sh = Worksheets(i).Name
            myQuery = "Select * from [" & myTable & "] Where [Emn No]= '" & UCase(Sh) & "'"
            Rs.Open myQuery, Con, 1, 1
            If Rs.RecordCount > 0 Then
                Worksheets(Sh).Range("A2:V" & Worksheets(Sh).Range("A" & Rows.Count).End(xlUp).Row).ClearContents
                Worksheets(Sh).Range("A2").CopyFromRecordset Rs
                Worksheets(Sh).Range("E:E,G:G").NumberFormat = "hh:mm;@"
            End If
            Rs.Close
            Case Else
        End Select
    Next i
    Sheets("Veri").Range("E:E,G:G").NumberFormat = "hh:mm;@"
    myQuery = vbNullString: SorguWhere = vbNullString: Set Rs = Nothing: Set Con = Nothing
End Sub

@NextLevel iyi akşamlar dilerim. Utanarak yazdığınız emek verdiğiniz kodunuzla alakalı bir şey danışacaktım. Lütfen kusuruma bakmayın böyle sürekli sizi uğraştırıyor yardım istiyorum. Kod şu an çok güzel çalışıyor emeğinize sağlık. Sadece bir iki durum ile ilgili danışacaktım;
Veri sayfasındaki verileri ilgili hücrelerle aynı isimdeki sayfalara sorunsuz dağıtıyor, fakat veri sayfasında 1. satır 5. hücrede bir değişiklik yapıyorum. Ve verdiğiniz makroyu tekrar çalıştırıyorum. Fakat bir değişiklik olmuyor. Büyük ihtimalle satır sayısında ve sayfa ismiyle aynı isme sahip hücrelerin bulunduğu 3. Sütunda bir değişiklik algılamadığı için verileri tekrar kopyalamıyor. Bu konuda koda bir güncelleme yapabilir miyiz? Verileri her halükarda tekrar kopyalasa mesela bence sorun çözülebilir.

Birde em321, em322 ve em323 sayfalarım var biliyorsunuz. Veri sayfasındaki em321 ile ilgili tüm satırları silip kodu çalıştırdığımda em321 sayfasındaki veriler hala kalıyor. Oradakileri temizlemiyor. Hatta sadece bir tane bırakıp diğer satırları silip denedim yine kodu çalıştırdığımda em321 sayfasında 1 satır veri olması gerekirken eski sildiğim veriler hala duruyor. Taki veri sayfasına em321 içeren yeni bir satır eklediğimde kod onu tanışmak istersen bu sefer eski sildiklerimi görüp temizliyor. Bu konuda yardımcı olabilirseniz çok sevinirim

ÖmerFaruk · 30 Nisan 2021

Sizin dosyanıza bir önceki kodları da ekleyerek çalıştırdım ama dediğiniz problemleri göremedim.
Ayrıca, kodlar değişikliğe felan bakmadan tüm veriyi olduğu gibi süzerek ve her defasında Em321-322-323 sayfalarınızın 2 ve altındaki tüm dolu satırları temizleyerek çalışıyor.
İnceleyin tekrar isterseniz.
https://dosya.co/vfnmujl77ari/furkan.xlsm.html

Veri Tabanındaki verilerim otomatik olarak ilgili sayfalara nasıl aktarılır?

Baturfurkan

Baturfurkan

FİLTRE işlevi - Microsoft Desteği

Baturfurkan

ÖmerFaruk

Destek Ekibi

ÖmerFaruk

Destek Ekibi

Baturfurkan

Baturfurkan

Baturfurkan

ÖmerFaruk

Destek Ekibi

Baturfurkan

ÖmerFaruk

Destek Ekibi

Baturfurkan

ÖmerFaruk

Destek Ekibi

Baturfurkan

ÖmerFaruk

Destek Ekibi