Soru Kapalı Dosyadan Veri Almak

ormann · 23 Nisan 2020

İyi günler ekli Ebat Listesi dosyasında veri girişi sayfasındaki Veri Al butonu ile ekli İstif dosyasındaki istif sayfasının aşağıda velirtmiş olduğum hücrelerindeki verileri makro ile veri girişi sayfasında ilgili yerlere makro aldırabilirmiyiz.
Link : https://dosya.co/womtsv6vns0y/Dosyalar.rar.html

Veri Alınacak İstif Dosyasının İstif Sayfasındaki ;
C1 >J7 hücresine
C2>J4 Hücresine
C3>J5 Hücresine
C4>J6 Hücresine
C5>J8 Hücresine
L4>J10 Hücresine
A10:A59>F20:F69 Hücresine
B8>G18 Hücresine
E8>H18 hücresine
H8>I18 hücresine
K8>J18 Hücresine
N8>K18 Hücresine
Q8>L18 Hücresine
T8>M18 Hücresine
W8>M18 Hücresine
B10:B59>G20:G69 Hücresine
E10:E59>H20:H69 Hücresine
H10:H59>I20:I69 Hücresine
K10:K59>J20:J69 Hücresine
N10:N59>K20:K69 Hücresine
Q10:Q59>L20:L69 Hücresine
T10:T59>M20:M69 Hücresine
W10:W59>N20:N69 Hücresine

Korhan Ayhan · 23 Nisan 2020

Aşağıdaki bölümde mükerrerlik söz konusu olmuş. Doğrusu nedir?

T8>M18 Hücresine
W8>M18 Hücresine

ormann · 23 Nisan 2020

Korhan bey, yanlış yazmışım
T8>M18
W8>N18 hücresine olacaktı

Korhan Ayhan · 23 Nisan 2020

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim Veri_Adresi As Variant, Hedef_Adres As Variant, X As Byte
    
    Zaman = Timer
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "İSTİF.xlsm"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Veri_Adresi = Array("C1:C1", "C2:C2", "C3:C3", "C4:C4", "C5:C5", "L4:L4", "A10:A59", "B8:B8", _
                  "E8:E8", "H8:H8", "K8:K8", "N8:N8", "Q8:Q8", "T8:T8", "W8:W8", "B10:B59", _
                  "E10:E59", "H10:H59", "K10:K59", "N10:N59", "Q10:Q59", "T10:T59", "W10:W59")
    
    Hedef_Adres = Array("J7", "J4", "J5", "J6", "J8", "J10", "F20", "G18", _
                  "H18", "I18", "J18", "K18", "L18", "M18", "N18", "G20", _
                  "H20", "I20", "J20", "K20", "L20", "M20", "N20")
    
    For X = 0 To UBound(Veri_Adresi)
        Sorgu = "Select * From [İSTİF$" & Veri_Adresi(X) & "]"
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
        S1.Range(Hedef_Adres(X)).CopyFromRecordset Kayit_Seti
    Next
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

ormann · 23 Nisan 2020

Korhan bey dosya yı kendimiz seçebilsek .Dosya Aç şeklinde. Dosya adı bazen farklı oluyor.Fakat sayfa ismi sabit değişmiyor. Dosya ismi İstif=8, İstif=9 vb.. şekilde olabiliyor. Dosyaları bütün excel formatların dan alabilir mi?

Korhan Ayhan · 23 Nisan 2020

Lütfen taleplerinizi ilk mesajınızda vermeye özen gösteriniz.

ormann · 23 Nisan 2020

Çok özür diliyorum.Kullandıkca aklıma geliyor

Korhan Ayhan · 23 Nisan 2020

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As Variant, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim Veri_Adresi As Variant, Hedef_Adres As Variant, X As Byte
    
    Zaman = Timer
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    
    Dosya = Application.GetOpenFilename("Excel Dosyaları (*.xl*),*.xl*", , "Hedef Dosyayı Seçin")
    If Dosya = False Then Exit Sub
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Veri_Adresi = Array("C1:C1", "C2:C2", "C3:C3", "C4:C4", "C5:C5", "L4:L4", "A10:A59", "B8:B8", _
                  "E8:E8", "H8:H8", "K8:K8", "N8:N8", "Q8:Q8", "T8:T8", "W8:W8", "B10:B59", _
                  "E10:E59", "H10:H59", "K10:K59", "N10:N59", "Q10:Q59", "T10:T59", "W10:W59")
    
    Hedef_Adres = Array("J7", "J4", "J5", "J6", "J8", "J10", "F20", "G18", _
                  "H18", "I18", "J18", "K18", "L18", "M18", "N18", "G20", _
                  "H20", "I20", "J20", "K20", "L20", "M20", "N20")
    
    For X = 0 To UBound(Veri_Adresi)
        Sorgu = "Select * From [İSTİF$" & Veri_Adresi(X) & "]"
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
        S1.Range(Hedef_Adres(X)).CopyFromRecordset Kayit_Seti
    Next
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

ormann · 23 Nisan 2020

Korhan hocam çok teşekkür ederim.İyi akşamlar

metin_0606 · 23 Nisan 2020

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim Veri_Adresi As Variant, Hedef_Adres As Variant, X As Byte
   
    Zaman = Timer
   
    Set S1 = Sheets("VERİ GİRİŞİ")
   
    Set Baglanti = CreateObject("AdoDb.Connection")
   
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "İSTİF.xlsm"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Veri_Adresi = Array("C1:C1", "C2:C2", "C3:C3", "C4:C4", "C5:C5", "L4:L4", "A10:A59", "B8:B8", _
                  "E8:E8", "H8:H8", "K8:K8", "N8:N8", "Q8:Q8", "T8:T8", "W8:W8", "B10:B59", _
                  "E10:E59", "H10:H59", "K10:K59", "N10:N59", "Q10:Q59", "T10:T59", "W10:W59")
   
    Hedef_Adres = Array("J7", "J4", "J5", "J6", "J8", "J10", "F20", "G18", _
                  "H18", "I18", "J18", "K18", "L18", "M18", "N18", "G20", _
                  "H20", "I20", "J20", "K20", "L20", "M20", "N20")
   
    For X = 0 To UBound(Veri_Adresi)
        Sorgu = "Select * From [İSTİF$" & Veri_Adresi(X) & "]"
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
        S1.Range(Hedef_Adres(X)).CopyFromRecordset Kayit_Seti
    Next
   
    Kayit_Seti.Close
    Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

Korhan bey ben bu kodlarınızı kendi çalışmama uyarladım gayet güzel çalıştı. Yapmak istediğim çalışma sayfamın F23 sütununda Etkin yazan personelleri getirtmek istiyorum. Sorgu satırında nasıl bir değişiklik yapabilirim.

Kod:

 Veri_Adresi = Array("A:A", "B:B", "C:C", "D:D", "G:G")
    
    Hedef_Adres = Array("A6", "B6", "C6", "D6", "E6")
    
    For X = 0 To UBound(Veri_Adresi)
        Sorgu = "Select * From [GRUPLAR$" & Veri_Adresi(X) & "]"    'VERİ ALDIĞIMIZ SAYFANIN İSMİ
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
        S1.Range(Hedef_Adres(X)).CopyFromRecordset Kayit_Seti

Korhan Ayhan · 23 Nisan 2020

F23 sütunu olmaz. F23 hücresi olabilir. Ya da F sütunu olabilir.

Sorgu şu şekilde olabilir.

C++:

"Select * From [GRUPLAR$" & Veri_Adresi(X) & "] Where [Sütun Başlığınız] = 'Etkin'"

ormann · 23 Nisan 2020

Korhan hocam birde ekli dosyada aktar butonu ile veriler masaüstüne Ebat Listesi klasörü içerisine veri girişi sayfasında J5 hücresindeki isimle dosya olarak kayıt yapılıyor. Kayıt yapılan dosyanın istifEbatExcelsayfası içerisine ÇAP;BOY;ADET olarak aktarılıyor.Bu aktarılan kaydı tekrar aynı yerlerine (Çapı,Adedi,İstif Numarası ,Cinsi) geri alabilir miyiz ?

İndir EBAT LİSTESİ PROGRAMI

Dosyayı indir EBAT LİSTESİ PROGRAMI

dosya.co

metin_0606 · 23 Nisan 2020

Korhan Ayhan' Alıntı:
F23 sütunu olmaz. F23 hücresi olabilir. Ya da F sütunu olabilir.

Sorgu şu şekilde olabilir.

C++:

"Select * From [GRUPLAR$" & Veri_Adresi(X) & "] Where [Sütun Başlığınız] = 'Etkin'"

Korhan Hocam Denedim ama olmadı Örnek dosya paylaşıyorum. Örnek dosya mevcut konumu ile çalışıyor Aynı zamanda Etkin koşulu olmadan getirttiğim zaman A ve B sütunlarının başlıklarını getirmiyor

Haluk · 23 Nisan 2020

Bunu deneyin ...

Kod:

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    
    Zaman = Timer
    
    Set S1 = Sheets("Takip_listesi")
    
    Set Baglanti = CreateObject("ADODB.Connection")
    
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "deneme.xlsx"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
                  Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select F1, F2, F3, F4 From [GRUPLAR$] where F23='Etkin'"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    S1.Range("A6").CopyFromRecordset Kayit_Seti
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

.

metin_0606 · 23 Nisan 2020

Haluk' Alıntı:

Bunu deneyin ...

Kod:

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim Veri_Adresi As Variant, Hedef_Adres As Variant, X As Byte
   
    Zaman = Timer
   
    Set S1 = Sheets("Takip_listesi")
   
    Set Baglanti = CreateObject("ADODB.Connection")
   
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "deneme.xlsx"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
                  Dosya & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select F1, F2, F3,F4 From [GRUPLAR$] where F23='Etkin'"
    Set Kayit_Seti = Baglanti.Execute(Sorgu)
    Range("A6").CopyFromRecordset Kayit_Seti
   
    Kayit_Seti.Close
    Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

.

Haluk hocam verileri başlıkları ile birlikte getirmek mümkünmü acaba

Korhan Ayhan · 23 Nisan 2020

@Haluk beyin cevabından sonra mesajımı düzeltme ihtiyacı hissettim.

Ben F23 ifadesini hücre adresi olarak yorumladığım için sütun olamaz ifadesini kullandım. Yanlış anlaşılmayı bu mesajımla düzeltelim. F23 ifadesi sorguda W sütununu ifade ediyor.

metin_0606 · 23 Nisan 2020

Korhan Ayhan' Alıntı:
@Haluk beyin cevabından sonra mesajımı düzeltme ihtiyacı hissettim.

Ben F23 ifadesini hücre adresi olarak yorumladığım için sütun olamaz ifadesini kullandım. Yanlış anlaşılmayı bu mesajımla düzeltelim. F23 ifadesi sorguda W sütununu ifade ediyor.

Korhan hocam sizin makronuza uygularken sütun başlığı olarakta uyguladım F23 olarakta W olarakta uyguladım ama bir türlü sonuç alamadım

Haluk · 23 Nisan 2020

metin_0606' Alıntı:
Haluk hocam verileri başlıkları ile birlikte getirmek mümkünmü acaba

Kod:

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim j As Integer
    
    Zaman = Timer
    
    Set S1 = Sheets("Takip_listesi")
    
    Set Baglanti = CreateObject("ADODB.Connection")
    
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "deneme.xlsx"
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
                  Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
    
    Sorgu = "Select [Başlık1], [Başlık2], [Başlık3], [Başlık4] From [GRUPLAR$] where [Başlık23]='Etkin'"
    
    Set Kayit_Seti = CreateObject("ADODB.Recordset")
    
    Kayit_Seti.Open Sorgu, Baglanti
    
    For j = 0 To Kayit_Seti.Fields.Count - 1
        S1.Cells(5, j + 1) = Kayit_Seti.Fields(j).Name
    Next
    
    S1.Range("A6").CopyFromRecordset Kayit_Seti
    
    Kayit_Seti.Close
    Baglanti.Close
    
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

.

metin_0606 · 23 Nisan 2020

Haluk' Alıntı:

Kod:

Sub Verileri_Aktar()
    Dim Dosya As String, Baglanti As Object, Sorgu As String
    Dim Kayit_Seti As Object, S1 As Worksheet, Zaman As Double
    Dim j As Integer
   
    Zaman = Timer
   
    Set S1 = Sheets("Takip_listesi")
   
    Set Baglanti = CreateObject("ADODB.Connection")
   
    Dosya = ThisWorkbook.Path & Application.PathSeparator & "deneme.xlsx"
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
                  Dosya & ";Extended Properties=""Excel 12.0;Hdr=Yes"""
   
    Sorgu = "Select [Başlık1], [Başlık2], [Başlık3], [Başlık4] From [GRUPLAR$] where [Başlık23]='Etkin'"
   
    Set Kayit_Seti = CreateObject("ADODB.Recordset")
   
    Kayit_Seti.Open Sorgu, Baglanti
   
    For j = 0 To Kayit_Seti.Fields.Count - 1
        S1.Cells(5, j + 1) = Kayit_Seti.Fields(j).Name
    Next
   
    S1.Range("A6").CopyFromRecordset Kayit_Seti
   
    Kayit_Seti.Close
    Baglanti.Close
   
    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
   
    MsgBox "Veri aktarımı tamamlanmıştır." & Chr(10) & Chr(10) & _
           "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation
End Sub

.

Teşekkürler hocam saygılar

ormann · 24 Nisan 2020

Günaydın ,
Ebat listesi sayfasında A1 hücresine sayfa ismini verdiğimizde aşağıdaki kodu İstif sayfasında degilde A1 hücresine verilen isimle veri alması için aşağıdaki kodu nasıl değiştirebiliriz

Kod:

Sorgu = "Select * From [İSTİF$" & Veri_Adresi(X) & "]"
        Set Kayit_Seti = Baglanti.Execute(Sorgu)
        S1.Range(Hedef_Adres(X)).CopyFromRecordset Kayit_Seti
    Next

Soru Kapalı Dosyadan Veri Almak

ormann

Korhan Ayhan

Administrator

ormann

Korhan Ayhan

Administrator

ormann

Korhan Ayhan

Administrator

ormann

Korhan Ayhan

Administrator

ormann

metin_0606

Korhan Ayhan

Administrator

ormann

İndir EBAT LİSTESİ PROGRAMI

metin_0606

Ekli dosyalar

Haluk

Özel Üye

metin_0606

Korhan Ayhan

Administrator

metin_0606

Haluk

Özel Üye

metin_0606

ormann