Soru Kapalı kitaplardan VERİ ÇEKMEK

[ERMAN SAYINALP]

Merhabalar,

Ekteki Örnek KLASÖR ve içeriğindeki DOSYALAR'da açıklamaya çalıştığım, çok sayıda Firmaya ait hepsi aynı formatta olan Excel sayfalarındaki bir kısım VERİ'leri, bu dosyalar kapalı durumdayken, yine aynı klasör içinde yer alan İCMAL isimli dosyaya çekmek istiyorum.

Konuya ilişkin, FONKSİYON ihtiyacım için değerli yardımlarınızı rica ederim.

Saygılarımla.

 

[Haluk]

Firmalara ait dosyalardaki tablolar, "İCMAL" dosyasındaki tablo formatında olursa bu iş biraz veritabanı mantığına benzer, o zaman da ADO falan kullanılarak düzgün bir çalışma yapılabilir. Yoksa, bakkal veresiye defterini temize çekmek gibi bir şey olur.....

.

 

[ERMAN SAYINALP]

???

 

[ERMAN SAYINALP]

Firmalara ait dosyalardaki tablolar, "İCMAL" dosyasındaki tablo formatında olursa bu iş biraz veritabanı mantığına benzer, o zaman da ADO falan kullanılarak düzgün bir çalışma yapılabilir. Yoksa, bakkal veresiye defterini temize çekmek gibi bir şey olur.....

.

Bu yazınız çözüme yönelik cevap mı ? Birşey anlamadım ?

 

[Haluk]

Evet, çözüme yönelik bir cevaptı..... Başka bir deyişle; düzgün bir çalışma yapmak istiyorsanız, işe ilk önce firma tablolarını İCMAL dosyasındaki formata dönüştermekle başlamanız gerekir.

.

 

[ERMAN SAYINALP]

Evet, çözüme yönelik bir cevaptı..... Başka bir deyişle; düzgün bir çalışma yapmak istiyorsanız, işe ilk önce firma tablolarını İCMAL dosyasındaki formata dönüştermekle başlamanız gerekir.

.

İşin neresinden başlanacağını, nasıl yapılacağını bana bırakın. Mevcut soru örneğime dair bir çözümünüz varsa ve paylaşırsanız sevinirim.

 

[Haluk]

Ben size teknik olarak kalıcı bir çözüm için yapılması gerekeni söyledim. Muhtemelen zaten o tabloları da birisine bırakmışlar, o şekilde hazırlanmış şimdi pirincin taşı ayıklanmaya çalışılıyor.

.

 

[ERMAN SAYINALP]

Ben size teknik olarak kalıcı bir çözüm için yapılması gerekeni söyledim. Muhtemelen zaten o tabloları da birisine bırakmışlar, o şekilde hazırlanmış şimdi pirincin taşı ayıklanmaya çalışılıyor.

.

Bak güzel kardeşim, ben 60 yaşında, İş Bankası üst düzey yöneticiliği yapmış birisiyim. Karşınızdakinin titrini, fikrini bilmeden, niyet okuyuculuğu yapmanızın bu mecrada soru soranlara faydası yok. Niyetiniz yardım etmekse lütfedin, biz de yararlanalım...

 

[Haluk]

Güzel kardeşim ben de sizinle aynı yaşta ve kamuda üst düzey yöneticilik yapmış biriyim. Ünvanların Excel ile ilgisi yok, sadece siz belirttiğiniz için ben de belirteyim dedim.....

Yukarıdaki mesajlarımda yazdıklarımın şahsınızın titriyle bir alakası yoktu. Amaç, geçmiş tecrübelerime dayanarak yol göstermekti.....

Neyse, kolay gelsin ....

.

 

[Korhan Ayhan]

İNDİS+KAÇINCI fonksiyonları ile çözüm hazırlamıştım. İnceleyiniz.

 

[ERMAN SAYINALP]

İNDİS+KAÇINCI fonksiyonları ile çözüm hazırlamıştım. İnceleyiniz.

Korhan bey merhaba,

Verdiğiniz çözüm önerinize baktım, lakin "Ana Dosya" dan "Veri" Dosyasına veri çekimine ilişkin, İNDİS+KAÇINCI fonksiyonları ile çözüm biçimi, maalesef benim ihtiyacıma uygun değil.

Sorumda da belirtmeye çalıştığım gibi, Formatları aynı olan yüzlerce dosyanın (belirli hücrelerindeki verileri), bu dosyalar kapalı halde duruken, İCMAL adlı başka bir dosyada basitçe bir araya getirmek amacı taşımaktadır.

Bu konuda yardımınız olursa sevinirim.

 

[Korhan Ayhan]

Klasörü sıkıştırırken benzer başka bir örnekle karışmış sanırım.

Üstteki mesajımda ki dosyayı revize ettim. Siz İCMAL dosyasını inceleyiniz.

 

[ERMAN SAYINALP]

Klasörü sıkıştırırken benzer başka bir örnekle karışmış sanırım.

Üstteki mesajımda ki dosyayı revize ettim. Siz İCMAL dosyasını inceleyiniz.

Korhan bey,

Evet, bir anlamda basit bir çözüm, ancak efektif değil, şöyle ki;

Yüzlerce Firmaya ait ve her biri o firmanın ismini taşıyan dosyalardan veri çekileceği için, verdiğiniz çözüm örneğinde olduğu üzere tüm veri çekme satırlarında Formul içine Firma ismi elle yazılacak, yeni bir firma dahil olduğunda İCMAL dosyası elle düzeltilecek, firmalardan çıkan olursa, yine İCMAL dosyası elle revize edilecek. Unutma, yazma ve silme hataları, söz konusu çözümü efektif olmaktan çıkaracaktır.

Bunun yerine bu işleri otomatik yapacak bir KODLAMA'ya ihtiyaç olduğu aşikar. Değerlendirir misiniz ?

 

[Korhan Ayhan]

Erman Bey,

Elbette kod ile çözümler üretlebilir. Sorunuzu fonksiyonlar bölümüne sormuşsunuz ve mesajınızda da BÜYÜK harfle FONKSİYON ihtiyacım diye belirtmişsiniz. Bu sebeple bu yönde cevap verdim.

Fonksiyonun dinamik olması için DOLAYLI fonksiyonu eklenebilir. Fakat bu fonksiyonun sonuç vermesi için dosyaların açık olması gerekiyor. Siz kapalı durumda dediğiniz içinde makro dışında pek bir alternatif kalmıyor.

 

[ERMAN SAYINALP]

Erman Bey,

Elbette kod ile çözümler üretlebilir. Sorunuzu fonksiyonlar bölümüne sormuşsunuz ve mesajınızda da BÜYÜK harfle FONKSİYON ihtiyacım diye belirtmişsiniz. Bu sebeple bu yönde cevap verdim.

Fonksiyonun dinamik olması için DOLAYLI fonksiyonu eklenebilir. Fakat bu fonksiyonun sonuç vermesi için dosyaların açık olması gerekiyor. Siz kapalı durumda dediğiniz içinde makro dışında pek bir alternatif kalmıyor.

Çok haklısınız, özür dilerim, o halde konuyu MAKRO'lar bölümüne mi açmalıyım, orada açarsam yine ilgilenebilir misiniz ?

 

[Korhan Ayhan]

Buradan devam edebilirsiniz.

 

[Haluk]

VBA ile alternatif ....

Sub Test()
    'Haluk - 15/12/2019
    'sa4truss@gmail.com
    Dim fDialog As FileDialog
    Dim FSO As Object
    Dim myDesktop As String
    Dim i As Integer, j As Integer
    Dim xRange As Range
    Dim myArgs() As Variant, argXL4 As String
    
    Range("A2:AH" & Rows.Count) = Empty
    
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Klasör seçin..."
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
    End With
    
    If fDialog.Show <> -1 Then
        Exit Sub
    Else
        myFolder = fDialog.SelectedItems(1)
    End If

    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(myFolder & Application.PathSeparator)
    
    i = 1
    
    For Each FileItem In SourceFolder.Files
        If Left(FileItem.Name, 2) = "~$" Or FileItem.Name = ThisWorkbook.Name Then GoTo ResumeFor:
        i = i + 1
        j = 1
        Cells(i, 1) = FileItem.Name
        strFolder = SourceFolder & Application.PathSeparator
        strFile = FileItem.Name
        strSheet = "Sayfa1"
        
        For Each xRange In Range("E4:E14,H4:H14,I4:I14")
            myArgs = Array(strFolder, strFile, strSheet, xRange.Address)
            argXL4 = "'" & myArgs(0) & "[" & myArgs(1) & "]" & myArgs(2) & "'!" & Range(myArgs(3)).Address(ReferenceStyle:=xlR1C1)
            j = j + 1
            Cells(i, j) = ExecuteExcel4Macro(argXL4)
        Next
ResumeFor:
    Next
    
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

.

 

[ERMAN SAYINALP]

VBA ile alternatif ....

Sub Test()
    'Haluk - 15/12/2019
    'sa4truss@gmail.com
    Dim fDialog As FileDialog
    Dim FSO As Object
    Dim myDesktop As String
    Dim i As Integer, j As Integer
    Dim xRange As Range
    Dim myArgs() As Variant, argXL4 As String
   
    Range("A2:AH" & Rows.Count) = Empty
   
    Set fDialog = Application.FileDialog(msoFileDialogFolderPicker)
    With fDialog
        .Title = "Klasör seçin..."
        .AllowMultiSelect = False
        .InitialFileName = Application.DefaultFilePath
        If .Show <> -1 Then Exit Sub
        myFolder = .SelectedItems(1)
    End With
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(myFolder & Application.PathSeparator)
    i = 1
   
    For Each FileItem In SourceFolder.Files
        If Left(FileItem.Name, 2) = "~$" Or FileItem.Name = ThisWorkbook.Name Then GoTo ResumeFor:
        i = i + 1
        j = 1
        Cells(i, 1) = FileItem.Name
        strFolder = SourceFolder & Application.PathSeparator
        strFile = FileItem.Name
        strSheet = "Sayfa1"
       
        For Each xRange In Range("E4:E14,H4:H14,I4:I14")
            myArgs = Array(strFolder, strFile, strSheet, xRange.Address)
            argXL4 = "'" & myArgs(0) & "[" & myArgs(1) & "]" & myArgs(2) & "'!" & Range(myArgs(3)).Address(ReferenceStyle:=xlR1C1)
            j = j + 1
            Cells(i, j) = ExecuteExcel4Macro(argXL4)
        Next
ResumeFor:
    Next
   
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

.

Haluk bey,

Harika, çok teşekkür ederim. Keşke bir sürü bişey yerine direkt olarak bu kodlamayı yazsaydınız, tanışmamız daha keyifli olacaktı. Madem cevap yazdınız, o halde ekstra bir isteğim olacak, lütfederseniz.

"Klasör seçin..." kodlaması yerine, otomatik olarak İCMAL dosyasının da içinde olduğu KLASÖR Adını kullanmasını sağlayabilir misiniz ?
Zira, VERİ içeren dosyalar da, İCMAL dosyası da aynı KLASÖR içinde yer almaktadır.

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

 

[Haluk]

Şöyle olabilir....

Sub Test()
    'Haluk - 15/12/2019
    'sa4truss@gmail.com
    Dim FSO As Object
    Dim i As Integer, j As Integer
    Dim xRange As Range
    Dim myArgs() As Variant, argXL4 As String
   
    Range("A2:AH" & Rows.Count) = Empty
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(ThisWorkbook.Path)
   
    i = 1
   
    For Each FileItem In SourceFolder.Files
        If Left(FileItem.Name, 2) = "~$" Or FileItem.Name = ThisWorkbook.Name Then GoTo ResumeFor:
        i = i + 1
        j = 1
        Cells(i, 1) = FileItem.Name
        strFolder = SourceFolder & Application.PathSeparator
        strFile = FileItem.Name
        strSheet = "Sayfa1"
       
        For Each xRange In Range("E4:E14,H4:H14,I4:I14")
            myArgs = Array(strFolder, strFile, strSheet, xRange.Address)
            argXL4 = "'" & myArgs(0) & "[" & myArgs(1) & "]" & myArgs(2) & "'!" & Range(myArgs(3)).Address(ReferenceStyle:=xlR1C1)
            j = j + 1
            Cells(i, j) = ExecuteExcel4Macro(argXL4)
        Next
ResumeFor:
    Next
    
    Range("X2:Y" & i).NumberFormat = "dd.mm.yyyy"
  
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Not: Verilerin olduğu firma dosyalarının formatı hakkındaki fikirlerim halen geçerlidir...


.

 

[ERMAN SAYINALP]

Şöyle olabilir....

Sub Test()
    'Haluk - 15/12/2019
    'sa4truss@gmail.com
    Dim FSO As Object
    Dim i As Integer, j As Integer
    Dim xRange As Range
    Dim myArgs() As Variant, argXL4 As String
   
    Range("A2:AH" & Rows.Count) = Empty
   
    Set FSO = CreateObject("Scripting.FileSystemObject")
    Set SourceFolder = FSO.GetFolder(ThisWorkbook.Path)
   
    i = 1
   
    For Each FileItem In SourceFolder.Files
        If Left(FileItem.Name, 2) = "~$" Or FileItem.Name = ThisWorkbook.Name Then GoTo ResumeFor:
        i = i + 1
        j = 1
        Cells(i, 1) = FileItem.Name
        strFolder = SourceFolder & Application.PathSeparator
        strFile = FileItem.Name
        strSheet = "Sayfa1"
       
        For Each xRange In Range("E4:E14,H4:H14,I4:I14")
            myArgs = Array(strFolder, strFile, strSheet, xRange.Address)
            argXL4 = "'" & myArgs(0) & "[" & myArgs(1) & "]" & myArgs(2) & "'!" & Range(myArgs(3)).Address(ReferenceStyle:=xlR1C1)
            j = j + 1
            Cells(i, j) = ExecuteExcel4Macro(argXL4)
        Next
ResumeFor:
    Next
   
    Set SourceFolder = Nothing
    Set FSO = Nothing
End Sub

Not: Verilerin olduğu firma dosyalarının formatı hakkındaki fikirlerim halen geçerlidir...


.

Son durum hakkında teşekkürlerimi yineliyorum. Sonuç mükemmel...

Bahsettiğiniz ve takıldığınız konuya gelince, çalışmamı tamamladığımda paket halinde sizinle paylaşayım ki, nasıl bir ürün ortaya çıktı, siz de görün. İnanıyorum ki, önyargılarınızı ortadan kaldıracak ve siz de beğeneceksiniz. Zira, Örnek üzerinden istediklerimi, sadece "inşaat temeli" gibi düşünün. İnşaatın kaba kısmı ve ince işçiliği, boyası, badanası, bittiğinde, yaptığınız bu yardımın nereye vardığını gösterecektir.

Görüşmek üzere...