Soru Kapalı kitaplardan VERİ ÇEKMEK

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Alternatif;

Hız olarak avantaj sağlayabilir.

Kod:
Option Explicit

Sub Verileri_Aktar()
    Dim K1 As Workbook, S1 As Worksheet, Yol As String
    Dim Dosya As String, Son As Long, Zaman As Double
    
    Zaman = Timer
    
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
    
    Yol = K1.Path & Application.PathSeparator
    
    S1.Range("A2:AH" & S1.Rows.Count).ClearContents
    Son = 2
    
    Dosya = Dir(Yol & "*.xls*")
    
    While Dosya <> ""
        If Dosya <> K1.Name Then
            S1.Cells(Son, 1) = Dosya
            
            With Range("B" & Son & ":L" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$E:$E,MATCH(B$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$D:$D,0))"
                .Value = .Value
            End With
            
            With Range("M" & Son & ":W" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$H:$H,MATCH(M$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$F:$F,0))"
                .Value = .Value
            End With
            
            With Range("X" & Son & ":AH" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$I:$I,MATCH(X$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$J:$J,0))"
                .Value = .Value
            End With
            
            Son = Son + 1
        End If
                
        Dosya = Dir
    Wend
    
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
    
    If Son - 1 > 1 Then
        MsgBox "Veri aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Klasörde veri aktarımı yapılacak dosya bulunamadı!", vbExclamation
    End If
End Sub
 

ERMAN SAYINALP

Altın Üye
Katılım
11 Eylül 2008
Mesajlar
173
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
08-09-2027
Alternatif;

Hız olarak avantaj sağlayabilir.

Kod:
Option Explicit

Sub Verileri_Aktar()
    Dim K1 As Workbook, S1 As Worksheet, Yol As String
    Dim Dosya As String, Son As Long, Zaman As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
   
    Yol = K1.Path & Application.PathSeparator
   
    S1.Range("A2:AH" & S1.Rows.Count).ClearContents
    Son = 2
   
    Dosya = Dir(Yol & "*.xls*")
   
    While Dosya <> ""
        If Dosya <> K1.Name Then
            S1.Cells(Son, 1) = Dosya
           
            With Range("B" & Son & ":L" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$E:$E,MATCH(B$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$D:$D,0))"
                .Value = .Value
            End With
           
            With Range("M" & Son & ":W" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$H:$H,MATCH(M$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$F:$F,0))"
                .Value = .Value
            End With
           
            With Range("X" & Son & ":AH" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$I:$I,MATCH(X$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$J:$J,0))"
                .Value = .Value
            End With
           
            Son = Son + 1
        End If
               
        Dosya = Dir
    Wend
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    If Son - 1 > 1 Then
        MsgBox "Veri aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Klasörde veri aktarımı yapılacak dosya bulunamadı!", vbExclamation
    End If
End Sub

Harikanın fevkinde, muhteşem, çok teşekkür ediyorum...
 

ERMAN SAYINALP

Altın Üye
Katılım
11 Eylül 2008
Mesajlar
173
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
08-09-2027
Korhan beycim merhaba,

Sizden değerli yardımlarınızı bir kez daha istirham ediyorum. Şöyle ki;

Bir Kitabın (Kaynak) (ör: Sayfa1) Sayfasından, bir başka Kitabın (Hedef) (ör:Sayfa1) Sayfasına Verileri taşımak istiyorum.

Koşullar;
  • Kaynak Sayfadan KOPYALA, Hedef Sayfaya YAPIŞTIR-DEĞERLER mantığıyla olmalı,
  • Makro Yeri HEDEF Dosyada olmalı,
  • Makro Tetiklendiğinde, KAYNAK Dosya Konumunu sormalı,
  • Yol gösterildiğinde, işlem sonuçlandırılmalı,
Taşınacak Veri Hücreleri;
  • Kaynak C2 --- Hedef C2
  • Kaynak D2 --- Hedef D2
  • Kaynak F2 --- Hedef F2
  • Kaynak C16 --- Hedef C18
  • Kaynak F16 : G16 --- Hedef F18 : G18
  • Kaynak C17 : G10000 --- Hedef C19 : G10000
  • Kaynak I16 : I10000 --- Hedef I18 : I10000
Konuya ilişkin bir MAKRO yazabilirseniz çok memnun olurum.

Görüşmek dileğiyle...
 

ERMAN SAYINALP

Altın Üye
Katılım
11 Eylül 2008
Mesajlar
173
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
08-09-2027
Alternatif;

Hız olarak avantaj sağlayabilir.

Kod:
Option Explicit

Sub Verileri_Aktar()
    Dim K1 As Workbook, S1 As Worksheet, Yol As String
    Dim Dosya As String, Son As Long, Zaman As Double
   
    Zaman = Timer
   
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
   
    Set K1 = ThisWorkbook
    Set S1 = K1.Sheets("Sayfa1")
   
    Yol = K1.Path & Application.PathSeparator
   
    S1.Range("A2:AH" & S1.Rows.Count).ClearContents
    Son = 2
   
    Dosya = Dir(Yol & "*.xls*")
   
    While Dosya <> ""
        If Dosya <> K1.Name Then
            S1.Cells(Son, 1) = Dosya
           
            With Range("B" & Son & ":L" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$E:$E,MATCH(B$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$D:$D,0))"
                .Value = .Value
            End With
           
            With Range("M" & Son & ":W" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$H:$H,MATCH(M$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$F:$F,0))"
                .Value = .Value
            End With
           
            With Range("X" & Son & ":AH" & Son)
                .Formula = "=INDEX('" & Yol & "[" & Dosya & "]Sayfa1'!$I:$I,MATCH(X$1," & "'" & Yol & "[" & Dosya & "]Sayfa1'!$J:$J,0))"
                .Value = .Value
            End With
           
            Son = Son + 1
        End If
               
        Dosya = Dir
    Wend
   
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
   
    If Son - 1 > 1 Then
        MsgBox "Veri aktarım işlemi tamamlanmıştır." & Chr(10) & Chr(10) & _
               "İşlem süresi ; " & Format(Timer - Zaman, "0.00") & " Saniye"
    Else
        MsgBox "Klasörde veri aktarımı yapılacak dosya bulunamadı!", vbExclamation
    End If
End Sub


Korhan bey, tekrar merhaba

"Kapalı Kitaplardan Veri Çekmek" konulu soruma karşın yukarıda yazdığınız kodlamayı, çalışmamın orjinaline uyguladığımda #YOK sonuçlarıyla karşılaştım. Yazılımın içeriğini bilemediğim için 10'larca test yaparak arızayı buldum. Şöyle ki;

Örnek Dosyalarda VERİ1, VERİ2 VERİ3 .... VERİ33 biçiminde yazdığım Veri Başlıkları, Orjinalinde Satışlar, İadeler, Tahsilatlar, Çekler, Senetler vs.vs gibi.
Bu yüzden sistem Veri Başlıklarını okuyamadığından, Veri çekilecek hücrelere #YOK hatası verdiriyor.

Yukarıdaki Kodlamayı, Veri Başlıklarının "Değişken kelimelerden" olduğunu belirtir şekilde Revize edebilir misiniz. ?

Vaki zahmetleriniz için şimdiden teşekkür ederim.

Saygılarımla.
 

ERMAN SAYINALP

Altın Üye
Katılım
11 Eylül 2008
Mesajlar
173
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
08-09-2027
Korhan bey, tekrar merhaba

"Kapalı Kitaplardan Veri Çekmek" konulu soruma karşın yukarıda yazdığınız kodlamayı, çalışmamın orjinaline uyguladığımda #YOK sonuçlarıyla karşılaştım. Yazılımın içeriğini bilemediğim için 10'larca test yaparak arızayı buldum. Şöyle ki;

Örnek Dosyalarda VERİ1, VERİ2 VERİ3 .... VERİ33 biçiminde yazdığım Veri Başlıkları, Orjinalinde Satışlar, İadeler, Tahsilatlar, Çekler, Senetler vs.vs gibi.
Bu yüzden sistem Veri Başlıklarını okuyamadığından, Veri çekilecek hücrelere #YOK hatası verdiriyor.

Yukarıdaki Kodlamayı, Veri Başlıklarının "Değişken kelimelerden" olduğunu belirtir şekilde Revize edebilir misiniz. ?

Vaki zahmetleriniz için şimdiden teşekkür ederim.

Saygılarımla.
Örnek Dosyaların (A Firması, B Firması, C Firması vs) Orjinal Görüntüsü ekteki gibidir.

Ancak Hücre Adresleri birebir aynıdır.Resim.JPG
 

Korhan Ayhan

Administrator
Yönetici
Admin
Katılım
15 Mart 2005
Mesajlar
42,249
Excel Vers. ve Dili
Microsoft 365 Tr-En 64 Bit
Erman Bey,

Kod arama yöntemi ile sonuç veriyor. Bu sebeple aranan verilerin aynı olması gerekiyor ki sonuç versin. Eğer verilerin sonunda ya da başında boşluk karakteri varsa eşleşme olmayacağı için sonuç olarak YOK hatası verecektir. Bu duruma dikkat ediniz.
 

ERMAN SAYINALP

Altın Üye
Katılım
11 Eylül 2008
Mesajlar
173
Excel Vers. ve Dili
Excel 2016 Türkçe
Altın Üyelik Bitiş Tarihi
08-09-2027
Erman Bey,

Kod arama yöntemi ile sonuç veriyor. Bu sebeple aranan verilerin aynı olması gerekiyor ki sonuç versin. Eğer verilerin sonunda ya da başında boşluk karakteri varsa eşleşme olmayacağı için sonuç olarak YOK hatası verecektir. Bu duruma dikkat ediniz.

Korhan bey,

Bu konu tamamdır, yardım istediğim diğer konu ile ilgili desteğiniz olabilir mi acaba ?
 
Üst