Veri Aktarma Butonu

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Arkadaşlar bir listem var. Kategorilerin olduğu sutunda A - B - C kategorileri var. Buton yardımı ile A kategorisindeki bilgileri A KATEGORİSİ sayfasını aktarmasını istiyorum ve yardılarınızı bekliyorum iyi çalışmalar.
 

Ekli dosyalar

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Aktar diye istekte bulunuyorsunuz ama A katorisi dediğiniz şey nedir? Veri içinde kategori diye bir seçenek göremedim.
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,

Aktar diye istekte bulunuyorsunuz ama A katorisi dediğiniz şey nedir? Veri içinde kategori diye bir seçenek göremedim.
Hocam LIST sayfasında her satırda ürün bilgileri var. D sutununda ise o ürünün hangi kategoride olduğu yazıyor. Amacım D sutunundaki kategori isimlerini sayfalara aktarmasını istiyorum. Örneğin LIST sayfasındaki D sütununda "A KATEGORİSİ" yazan satırları A KATEGORİSİ sayfasına, "B KATEGORİSİ" yazanları B KATEGORİSİ sayfalarına aktarmasını istiyorum. İlginiz için teşekkür ederim
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
:) Dosyayı değiştirmişsiniz, şimdi oldu
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
   
    Set Syf = Sheets(Application.Caller)
   
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
   
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
   
    Dim i As Integer
   
   
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
   
    filename = ThisWorkbook.FullName
   
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                   
    rs.Open query, connection
   
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
   
    Syf.Range("A2").CopyFromRecordset rs
   
    connection.Close
   
End Sub
 

Ekli dosyalar

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
  
    Set Syf = Sheets(Application.Caller)
  
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
  
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
  
    Dim i As Integer
  
  
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
  
    filename = ThisWorkbook.FullName
  
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                  
    rs.Open query, connection
  
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
  
    Syf.Range("A2").CopyFromRecordset rs
  
    connection.Close
  
End Sub
Hocam elinize sağlık çok güzel olmuş teşekkür ederim :)
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,
İdris Bey yol göstermiş.

ADO ile çözüm. Diktörtgen şekillerinin isimlerini inceleyiniz.

Kod:
Sub Aktar()

    Dim Syf As Worksheet
  
    Set Syf = Sheets(Application.Caller)
  
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    On Error Resume Next
  
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
  
    Dim i As Integer
  
  
    query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
  
    filename = ThisWorkbook.FullName
  
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                  
    rs.Open query, connection
  
    Dim tbl As Range
    Set tbl = Syf.Range("A1").CurrentRegion
    tbl.Offset(1, 0).Resize(tbl.Rows.Count - 1, tbl.Columns.Count).ClearContents
  
    Syf.Range("A2").CopyFromRecordset rs
  
    connection.Close
  
End Sub
Hocak bu kodun içerisinde dikdörtgen isimlerinin geçtiği yer neresidir bilgi verebilir misiniz
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Tüm şekillere aynı makro atandı.
Hangi şekle tıklandığını :
Kod:
Set Syf = Sheets(Application.Caller)
kod ile öğreniyoruz. Şeklin adı aynı zamanda istenen ve aynı zamanda sayfa adı oluyor.
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,

Tüm şekillere aynı makro atandı.
Hangi şekle tıklandığını :
Kod:
Set Syf = Sheets(Application.Caller)
kod ile öğreniyoruz. Şeklin adı aynı zamanda istenen ve aynı zamanda sayfa adı oluyor.
Hocam harika bir çalışma ayakta alkışlıyorum bu çalışmayı nasıl yaptığınıza dair bir video veya eğitim mevcut mudur
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
Tavsiyeniz doğrultusunda çalışmalarıma devam edeceğim çok teşekkür emeğinize
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Mevcut değildir, biraz işin pratiğine kaçtım.
Aslında Ben olsam 3 tane buton yerine ya inputbox ile ya da form düzenleyerek combobox ile listelenecek sayfayı alırdım.
Sizin öneriniz doğrultusunda bu atraksiyonu yaptım.
hocam bi sorum olacak örneğin A kategorinde olanları tümüyle ( A sütunundan I sütünuna kadar) A KATEGORİSİ sayfasına atıyor. Ben sadece A Kategorisi nde olanları tümüyle değil de --> kategori adı (D), ürün ismi (G) ve gideceği yer (I) bilgilerini aktarmasını istersem nasıl yol izleyebilirim
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
Çok teşekkür ediyorum hocam sayenizde öğreniyorum :)
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,

Koddaki :

Kod:
query = "SELECT * FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
* tüm bilgiyi demektir.

Aşağıdaki gibi kullanın :

Kod:
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
Yani hangi sütünu istiyorsak o sütun başlığını köşeli parantez içinde veriyoruz, çünkü arada boşluk karakteri olduğu için.
Örneğin sadece AD başlığı olsaydı bunu köşeli parantez içine almak gerekmezdi.
hocam son bi sorum olacak sadece projem bitiyor. Verdiğiniz kod doğrultusunda her şey sorunsuz çalışıyor. Kategori adı, Ürün ismi ve Gideceği yer sütunlarını Syf.Range("A2").CopyFromRecordset rs getiriyor. Kategori adı'nı G2 ye, Ürün İsmini D2 ye ve son olarak Gideceği yer' i I2 ye nasıl getirebilirim bir çok yol denedim ama başaramadım.
 

Necdet

Moderatör
Yönetici
Katılım
4 Haziran 2005
Mesajlar
15,359
Excel Vers. ve Dili
Ofis 365 Türkçe
Merhaba,

RecordSet'in belirli sütunlarını almak hiç aklıma gelmemişti, araştırdık bulduk :)

Kod:
Sub Aktar()

    Dim Syf As Worksheet
    
    Set Syf = Sheets(Application.Caller)
    
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
    
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
    
    Dim i As Long
    
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
    
    filename = ThisWorkbook.FullName
    
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                    
    rs.Open query, connection
        
'    Syf.Range("A2").CopyFromRecordset rs.Fields(3)
    i = 2
    With rs
        Do Until .EOF
            Debug.Print rs.Fields(1) & " " & rs.Fields(0) & " " & rs.Fields(2)
            Syf.Range("D" & i) = rs.Fields(1)   'Ürün İsmi
            Syf.Range("G" & i) = rs.Fields(0)   'Kategori Adı
            Syf.Range("I" & i) = rs.Fields(2)   'Gideceği Yer
        .MoveNext
        i = i + 1
        Loop
    End With
    
    connection.Close
    
End Sub
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
hocam gerçekten siz bir dahisiniz ellerinize sağlık çok teşekkür ediyorum muhteşemsiniz :)
 

csncesur

Altın Üye
Katılım
12 Ekim 2021
Mesajlar
91
Excel Vers. ve Dili
Türkçe
Altın Üyelik Bitiş Tarihi
21-02-2025
Merhaba,

RecordSet'in belirli sütunlarını almak hiç aklıma gelmemişti, araştırdık bulduk :)

Kod:
Sub Aktar()

    Dim Syf As Worksheet
   
    Set Syf = Sheets(Application.Caller)
   
    'Referanslardan Microsoft Activex Data Objects 6.1 (veya daha fazlası) Library Seçili olmalı
   
    Dim connection As New ADODB.connection
    Dim filename As String
    Dim query As String
    Dim rs As New ADODB.Recordset
    Dim Kol As Integer
   
    Dim i As Long
   
    query = "SELECT [KATEGORİ ADI], [ÜRÜN İSMİ],[GİDECEĞİ YER] FROM [LIST$] WHERE [KATEGORİ ADI] = '" & Application.Caller & "'"
   
    filename = ThisWorkbook.FullName
   
    connection.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & filename & _
                ";Extended Properties=""Excel 12.0;HDR=Yes;"";"
                   
    rs.Open query, connection
       
'    Syf.Range("A2").CopyFromRecordset rs.Fields(3)
    i = 2
    With rs
        Do Until .EOF
            Debug.Print rs.Fields(1) & " " & rs.Fields(0) & " " & rs.Fields(2)
            Syf.Range("D" & i) = rs.Fields(1)   'Ürün İsmi
            Syf.Range("G" & i) = rs.Fields(0)   'Kategori Adı
            Syf.Range("I" & i) = rs.Fields(2)   'Gideceği Yer
        .MoveNext
        i = i + 1
        Loop
    End With
   
    connection.Close
   
End Sub
hocam gerçekten siz bir dahisiniz ellerinize sağlık çok teşekkür ediyorum muhteşemsiniz :)
 
Üst