• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kapalı dosyadan veri alma

  • Konbuyu başlatan Konbuyu başlatan mars2
  • Başlangıç tarihi Başlangıç tarihi
M

mars2

Katılım
2 Eylül 2004
Mesajlar
612
Excel Vers. ve Dili
2016 - Türkçe
2019 - Türkçe
İyi Günler;
Kapalı dosyadan veri alarak işlem yapmak istiyorum. Aşağıdaki macro ile taşınmaz bazında genel toplam almak istiyorum. Ancak, makro’yu çalıştırdığımda

Run-time error “100”
Bu çalışma sayfasındaki bir formül bir veya daha fazla geçersiz başvuru içeriyor.
Formüllerinizin geçerli bir yol, çalışma kitabı, aralık adı veya hücre başvurusu içerdiği doğrulayın. Mesajı çıkmaktadır.


Buna göre; nerede yanlışlık yapılmakta oluıp, yapmak gereken nedir.

Sub taşınmaz()
Sheets("genel").Range("B21:Q32").Value = ""
Dim Yıl, Klasör, Dosya, Yol, isim As String
Application.ScreenUpdating = Fals
Klasör = "D:\belgeler\bankaya yatanlar\2009 yili ve devami\"
isim = [B4].Value
For i = 2 To 3 'YILLAR İÇİN 2011 ve devamı için 3 bir fazlalaştırılacak
Yıl = Cells(20, i).Value
Dosya = Yıl & ".xls"
For j = 7 To 100 'DOSYA İÇİN
Yol = "'" & Klasör & "[" & Dosya & "]" & "dosyatoplam'!R" & j & "B"
If isim = ExecuteExcel4Macro(Yol & 3) Then
For k = 21 To 32 ' AYLAR İÇİN
'ay = Cells(k, 1).Value
Cells(k, i) = ExecuteExcel4Macro(Yol & k - 17)
Next k
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbOKOnly, "SERVİS"

End Sub

Hata bu satırda vermektedir.
If isim = ExecuteExcel4Macro(Yol & 3) Then
 
Aşağıdaki yeri değiştirip deneyiniz.
"C" = Kolon anlamına geliyor.
"R" = Satır anlamına geliyor.:cool:
Yol = "'" & Klasör & "[" & Dosya & "]" & "dosyatoplam'!R" & j & "C"
 
Cevabınız içinm teşekkürler. Ancak, Yol satırı ile if satırının yerini değiştirdim. bu sefer verileri almamakta. bu makro isim üzerinde olundupğunda çalışmaktadır.
 
Aşağıdaki yeri değiştirip deneyiniz.
"C" = Kolon anlamına geliyor.
"R" = Satır anlamına geliyor.:cool:
Yol = "'" & Klasör & "[" & Dosya & "]" & "dosyatoplam'!R" & j & "C"
Genişletmek için tıkla ...
mars2' Alıntı:
Cevabınız içinm teşekkürler. Ancak, Yol satırı ile if satırının yerini değiştirdim. bu sefer verileri almamakta. bu makro isim üzerinde olundupğunda çalışmaktadır.
Genişletmek için tıkla ...
Ben böyle bir çözüm önermedim.
Sadece "B" yerine "C" yazın dedim.:cool:
 
İyi Günler;
Run-timer error "1004"
Yazdığını formülde bir hata var mesajı çıkmaktadır.
Neden olabilir.
 
Kod aşağıda dır

Sub taşınmaz()
Sheets("genel").Range("B21:Q32").Value = ""
Dim Yıl, Klasör, Dosya, Yol, isim As String
Application.ScreenUpdating = Fals
Klasör = "D:\belgeler\bankaya yatanlar\2009 yili ve devami\"
isim = [B4].Value
For i = 2 To 3 'YILLAR İÇİN 2011 ve devamı için 3 bir fazlalaştırılacak
Yıl = Cells(20, i).Value
Dosya = Yıl & ".xls"
For j = 7 To 100 'DOSYA İÇİN
Yol = "'" & Klasör & "[" & Dosya & "]" & "dosyatoplam'!R" & j & "B"
If isim = ExecuteExcel4Macro(Yol & 3) Then
For k = 21 To 32 ' AYLAR İÇİN
'ay = Cells(k, 1).Value
Cells(k, i) = ExecuteExcel4Macro(Yol & k - 17)
Next k
End If
Next j
Next i
Application.ScreenUpdating = True
MsgBox "İşlem tamamlandı", vbOKOnly, "SERVİS"

End Sub


hata
If isim = ExecuteExcel4Macro(Yol & 3) Then satırda vermektedir.
 
isim dosyanın adı ve uzantısı ise ve klasörde olup olmadığı sorgulanıyorsa.:cool:
Kod: 
if dir(klasör & isim) <> "" then
 
Ayrıca demek istediğiniz üstteki mesaj değilse ben size 2nci mesajda sorunun yanıtını zaten vermişim.:cool:
 
Sayın Evren;
cevap ve ilginiz içi,mn teşekürler.
en son verdiğiniz satırı değiştirmemem rağmen verileri almadım.
Buna ilişkin örnek ektedir.
Dosya bazında yıllar itibariyla yatan paraları takip etmek istiyorum.
 
Ana dosya ile diğer verilerin alanacağı dosyalar ayni klasörde olamalı.
Ado kullanılarak sonuca gidildi.:cool:
Dosyanız ektedir.:cool:
Kod: 
Sub yillaritopla()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim j As Integer, i As Byte, tpl As Double, dosya As String, son As Integer
Dim ay As String
Sheets("geneltoplam").Select
Range("B20:IV31").ClearContents
son = Cells(19, "IV").End(xlToLeft).Column
Application.ScreenUpdating = False
For j = 2 To son
    If Dir(ThisWorkbook.Path & "\" & Cells(19, j).Value & ".xls") <> "" Then
        Set conn = New ADODB.Connection
        conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\" & Cells(19, j).Value & ".xls;extended properties=""excel 8.0;hdr=yes""")
        For i = 20 To 31
            Set rs = New ADODB.Recordset
            ay = UCase(Replace(Replace(Cells(i, "A").Value, "ı", "I"), "i", "İ"))
            rs.Open "Select sum(" & ay & ") from [yiltoplami$]", conn, adOpenKeyset, adLockReadOnly

            If IsNull(rs(0).Value) Then
                Cells(i, j).Value = ""
                Else
                Cells(i, j).Value = rs(0).Value
            End If
            rs.Close
        Next i
        Set rs = Nothing
        conn.Close
        Set conn = Nothing
    End If
Next j
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 
İyi günler;
takip kitabının geneltoplam sayfasında dosya numarasını yazıp, verileri çağırdığımızda yıllardaki ilgi ayın içinde bulunan miktar gelmeketedir.

ÖrneK:,
B4 hücresine 635001 yazılıp kaydet düğmesine basıldığında geneltoplam sayfasının 2009 ocak ayına ait B20 hücresine 115 gelmesi gerekirken, 3492 rakamı gelmektedir.
 
mars2' Alıntı:
İyi günler;
takip kitabının geneltoplam sayfasında dosya numarasını yazıp, verileri çağırdığımızda yıllardaki ilgi ayın içinde bulunan miktar gelmeketedir.

ÖrneK:,
B4 hücresine 635001 yazılıp kaydet düğmesine basıldığında geneltoplam sayfasının 2009 ocak ayına ait B20 hücresine 115 gelmesi gerekirken, 3492 rakamı gelmektedir.
Genişletmek için tıkla ...
Kaynak dosyalardaki sütun başlıklarında aralarında boşluk bırakmayınız.
ben her 2 dosyadaki başlığı aşağıdaki şekilde değiştirdim.Arasındaki boşluğu Alt tire yaptım.Daha önceden dosya numarasına göre bir ifade görmediğimden tüm ayı topladım.Ondan öyle oldu.Şimdi istediğiniz düzenlemeyi yaptım.Dosya ektedir.:cool:
Taşınmaz_No
Kod: 
Sub yillaritopla()
Dim conn As ADODB.Connection, rs As ADODB.Recordset
Dim j As Integer, i As Byte, tpl As Double, dosya As String, son As Integer
Dim ay As String, no As Double

Sheets("geneltoplam").Select
If Range("B4").Value = "" Then
    MsgBox "Dosya Numarası boş" & vbLf & "Bir dosya numarsı girmelisiniz.", vbCritical, "UYARI"
    Range("B4").Select
    Exit Sub
End If
no = Range("B4").Value
Range("B20:IV31").ClearContents
son = Cells(19, "IV").End(xlToLeft).Column
Application.ScreenUpdating = False
For j = 2 To son
    If Dir(ThisWorkbook.Path & "\" & Cells(19, j).Value & ".xls") <> "" Then
        Set conn = New ADODB.Connection
        conn.Open ("provider=microsoft.jet.oledb.4.0;data source=" & ThisWorkbook.Path & "\" & Cells(19, j).Value & ".xls;extended properties=""excel 8.0;hdr=yes""")
        For i = 20 To 31
            Set rs = New ADODB.Recordset
            ay = UCase(Replace(Replace(Cells(i, "A").Value, "ı", "I"), "i", "İ"))
            rs.Open "Select sum(" & ay & ") from [yiltoplami$] where Taşınmaz_No = " & no, conn, adOpenKeyset, adLockReadOnly
            If IsNull(rs(0).Value) Then
                Cells(i, j).Value = ""
                Else
                Cells(i, j).Value = rs(0).Value
            End If
            rs.Close
        Next i
        Set rs = Nothing
        conn.Close
        Set conn = Nothing
    End If
Next j
Application.ScreenUpdating = True
MsgBox "İşlem Tamamlanmıştır." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 
Sayın Evren;
Cevabınız için teşekkürler örnek tam istediğim gibi olmuş, örnek çalışmakta kodu kendi uyguladığımda,

Dim conn As ADODB.Connection, hata vermektedir.

neden olabilir.
 
Selamlar,

VBA kod ekranındayken;

TOOLS-REFERENCES menüsünden "Microsoft ActiveX Data Objects X.X Library" referansını aktif hale getirip deneyin.
 
Teşekkürler.
Yıllar içinde bulunan verileri, kendi uygulmamda almamktadır. nedeni ne olabilir.
 
mars2' Alıntı:
Teşekkürler.
Yıllar içinde bulunan verileri, kendi uygulmamda almamktadır. nedeni ne olabilir.
Genişletmek için tıkla ...
Yılara ait dosyaların isimlerini veriyi aldığınız sayfada yazılımı veya aynimi.Orada 2008-2009-2010 diye giden dosyalarınızn ayni simde olması lazım.Bilde çalıştırdığınız dosyanında diğer dosyalarla ayni klasörde olamalı.:cool:
 
Sayın Evren Gizem;
İyi günler dilerim. yardımlarınız için, en son mesajınızda isimler, yıllara bakmmaı tavsiye etmektesiniz. hepsine bakmakma rağmane aynı hata yapmakta sizde, dosyanın orjinalini gönderrek hatanın nereden kaynaklandığı ve yardımınız mümkün olabilir mi?
 
mars2' Alıntı:
Sayın Evren Gizem;
İyi günler dilerim. yardımlarınız için, en son mesajınızda isimler, yıllara bakmmaı tavsiye etmektesiniz. hepsine bakmakma rağmane aynı hata yapmakta sizde, dosyanın orjinalini gönderrek hatanın nereden kaynaklandığı ve yardımınız mümkün olabilir mi?
Genişletmek için tıkla ...
Sütun başlıklarına baktınızmı kaynak dosyalara.Sütun başlıklarında boşluk yerine alt tire ( _ ) olmalı.
 
Sayın Evren;
Sutun başlıklarına baktım ancak, yine olmuyor yine olmuyor.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst