• DİKKAT

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

formüllemede sorun

  • Konbuyu başlatan Konbuyu başlatan desk
  • Başlangıç tarihi Başlangıç tarihi
Katılım
17 Ekim 2005
Mesajlar
288
Excel Vers. ve Dili
excel 2010 türkçe
KLASÖRDEKİ TÜM DOSYALARDAKİ M1 HÜCRESİNE FORMÜL YERLEŞTİRMEYE ÇALIŞIYORUM NERDE HATA YAPIYORUM?

Sub Klasördeki_Dosyalara_Formül_Uygula()
Dim Klasör As Object
Dim İlk_Süre As Date, Son_Süre As Date, Toplam_Süre As Date
Set Klasör = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçiniz !", 1)
İlk_Süre = Time
[A2:B65536].ClearContents
Liste (Klasör.Items.Item.Path)
Alt_Liste (Klasör.Items.Item.Path)
Set Klasör = Nothing
Son_Süre = Time
Toplam_Süre = Format(Son_Süre - İlk_Süre, "hh:mm:ss")
MsgBox "İşleminiz tamamlanmıştır." & vbCrLf & "İşlem süresi ; " & Toplam_Süre, vbInformation
End Sub

Private Sub Liste(Yol As String)
Dim Dosya As String, Hedef_Dosya As Workbook
On Error Resume Next
Dosya = Dir(Yol & "\*.xls")

While Dosya <> ""
Application.ScreenUpdating = False
DoEvents
Set Hedef_Dosya = Workbooks.Open(Yol & "\" & Dosya, False, False)
Range("M1").Formula = "=subtotal(9,J1:J3000)-subtotal(9,K1:3000)"

Hedef_Dosya.Close True
Dosya = Dir
Application.ScreenUpdating = True
Wend
End Sub

Private Sub Alt_Liste(Yol As String)
Dim Alt_Klasör As Object, Alt_Dosya As Object, Dosya As String, Hedef_Dosya As Workbook
Set Alt_Klasör = CreateObject("Scripting.FileSystemObject").GetFolder(Yol).SubFolders

On Error GoTo Devam

For Each Alt_Dosya In Alt_Klasör
Dosya = Dir(Alt_Dosya.Path & "\*.xls")
While Dosya <> ""
Application.ScreenUpdating = False
DoEvents
Set Hedef_Dosya = Workbooks.Open(Alt_Dosya & "\" & Dosya, False, False)
Range("M1").Formula = "=subtotal(9,J1:J3000)-subtotal(9,K1:3000)"
Hedef_Dosya.Close True
Dosya = Dir
Application.ScreenUpdating = True
Wend
Alt_Liste (Alt_Dosya.Path)
Devam:
Next
Set Alt_Klasör = Nothing
End Sub
 
"=subtotal(9,J1:J3000)-subtotal(9,K1:3000)"
FORMÜLÜMDEMİ YANLIŞLIK VAR ZİRA NORMAL BİR TOPLAMA FORMÜLÜ YERLEŞİYOR
 
Merhaba ,

Test etmedim ama tahmini olarak cevap yazıyorum.
Formulu vba da aşagıdaki gibi kullanınız.
Eğer Sheets ismide biliyorsanız ona göre düzenlersiniz
Kod:
Range("M1").Formula = WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("J1:J3000")) - WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("K1:3000"))
 
birde kayıt esnasında kayıt tuşunu kullanırken şifre sorması şeklinde ayarlamıştım şifreyi nasıl geçittirebilirim her dosyada kayıt tuşu şifreli. örnek şifre ab
 
Formülü koyuyor fakat #ad? şeklinde görünüyor üstünde bir kere enter yaptığımda düzeliyor bunu nasıl aşabilirim.
 
Merhaba;

Kod:
Range("M1").Formula = WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("J1:J3000")) - WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("K1:3000"))
Range("m1")=WorksheetFunction.Clean(Range("m1"))
Range("m1").select

Yukarıdaki kodu denermisiniz.
 
DOSYAYA KAYIT EDİLMEYE ÇALIŞILDIĞINDA KAYDET TUŞUNA ŞİFRE KOYDUM.
bunu nasıl aştırabilirim.
 
Merhaba;

Kod:
Range("M1").Formula = WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("J1:J3000")) - WorksheetFunction.Subtotal(9, Sheets(isminiyaz).Range("K1:3000"))
Range("m1")=WorksheetFunction.Clean(Range("m1"))
Range("m1").select

Yukarıdaki kodu denermisiniz.
bu şekilde sadece sonucu bırakıyor formülü siliyor ben formülün orda sabit kalmasını istiyorum amacım oraya formülü yerleştirmek. sağlıklı sonuç verecek şekilde.
 
Range("M1").Formula = "=SUBTOTAL(9,J1:J3000)-SUBTOTAL(9,K1:K3000)"
Range("M1") = WorksheetFunction.Clean(Range("M1"))
Range("M1").Select

bu şekilde sadece sonucu veriyor formülü siliyor amacım orda belirttiğim formülü oluşturmak ve sağlıklı çalışmasını sağlamak.
 
sonuç derken neyi kastettiğini anlamadım çünkü görünen #ad? bu fakat içindeki formül doğru içine girip enter yaptığımda sonuçta normal olarak formülü uygulanmış veriyor
 
Arkadaşlar yardım edebilirmisiniz acil.
 
Geri
Üst