• DİKKAT

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

Klasör içindeki excel dosyalarını açmadan makro çalıştırıp değişiklik yapmak

Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
H

hrryet

Katılım
4 Eylül 2009
Mesajlar
40
Excel Vers. ve Dili
excell 2007 türkçe
Arkadaşlar merhaba.

Benim çok acil yardıma ihtiyacım var.

Şöyleki bilgisayarımda "listeler" isimli bir klasörüm var. bu klasör içinde 2000'e yakın excel dosyası var (her bir excel dosyasının adı farklı).

benim elimde bul-değiştir şeklinde bir makro var. mesela ayşe olanları bul ali yap gibi. fakat ben bunu tüm excel dosyalarını tek tek açarak çalıştırabiliyorum. bu benim çok fazla vaktimi alıyor.

bu excel dosyalarının içini açmadan, direkt klasör içinde makromu bir kerede çalıştırıp tüm excellerdeki kolon başlıklarını bir kerede aynı şekilde düzenlemek istiyorum. böyle bir şey mümkün mü acaba? bilgi verebilirseniz, yardımcı olabilirseniz çok sevinirim.
bu konuda yardımcı olabilecek arkadaşlara şimdiden çok çok teşekkür ediyorum.

herkese iyi çalışmalar.
 
hrryet' Alıntı:
Arkadaşlar merhaba.

Benim çok acil yardıma ihtiyacım var.

Şöyleki bilgisayarımda "listeler" isimli bir klasörüm var. bu klasör içinde 2000'e yakın excel dosyası var (her bir excel dosyasının adı farklı).

benim elimde bul-değiştir şeklinde bir makro var. mesela ayşe olanları bul ali yap gibi. fakat ben bunu tüm excel dosyalarını tek tek açarak çalıştırabiliyorum. bu benim çok fazla vaktimi alıyor.

bu excel dosyalarının içini açmadan, direkt klasör içinde makromu bir kerede çalıştırıp tüm excellerdeki kolon başlıklarını bir kerede aynı şekilde düzenlemek istiyorum. böyle bir şey mümkün mü acaba? bilgi verebilirseniz, yardımcı olabilirseniz çok sevinirim.
bu konuda yardımcı olabilecek arkadaşlara şimdiden çok çok teşekkür ediyorum.

herkese iyi çalışmalar.
Genişletmek için tıkla ...

Mümkün.
Sayfa adları hepsinde aynimi.
Verinin aranıp değiştirilieceiği sütun hangisi.
Hangi veri değiştirelecek.
Dosyanaıaı ve değiştirilecek dosyalaradan bir kaç tane örnek ekleyip yollarsanız yardımcı oluruz.Not dosyaları 2003 formatında yüklerseniz iyi olur.2007 herkeste yok çünkü.Bendede.:cool:
 
Sayfa adları hepsinde aynı değil maalesef. dosyalar ay isimleriyle ay-yıl olarak kayıtlı. mesela aralık_2009 şeklinde.

aşağıda eklediğim dosyalarda "ALBÜM"




ilginize çok teşekkür ederim.
 
Sayfa adları hepsinde aynı değil maalesef. dosyalar ay isimleriyle ay_yıl olarak kayıtlı. mesela aralık_2009 şeklinde.

aşağıda eklediğim dosyalarda "ALBÜM" yazan kolon başlığını "album", " İCRACI" yazan kolon başlığını "yorumcuAd" , "ESER" yazan kolon başlığını da "eserAd", "KONTÖR YÜKLEME/DOWNLOAD" yazan kolon başlığını da "calmaSayisi" olarak düzeltmek istiyorum.

Birde dosyalarda yıl ve ay kolonları da hiç yok. ben yukarıda yapmak istediğime ek olarak bu 2 kolonu da açıp içerisine dosyanın adındaki yılı ve ayı ya yazmak istiyorum.

Detayları dosya içine tekrar yazdım.

İlginize çok teşekkür ederim. Kolay gelsin.
 

Ekli dosyalar

Sanırım sayfa adları dosya adı ile ayni.
Peki değiştirilecek verinin ismi nerden alınacak.Hangi sütunda olacak bu isim.
Ve bulunanların nereleri nasıl diğiştirilecek?
Diğer konu ,Sütun başlıklarının değişmesi ve sayfa adının sütun başlığı olarak 2 ilave olması haledikldi.
Diğer dosyalarla ayni klasörde olması lazım.1 kere kulanmanız yetrlidir.
Dosya lar ektedir.Tüm klasör içinde bulunan tüm dosyalarda işlemi yapar.:cool:
Bu dosyaya bakın dönüş yapın sonra diğerleri için devam edicez.:cool:

Kod: 
Sub kolon_basliklrini_degisitr_ekle_59()
Dim sh As Worksheet, fso As Object, fs As Object, ad As String
Dim tar, sut As Byte, j As Byte, sat As Long
If MsgBox("Sayfa'daki sütun adlarını değiştirmek ve 2" _
 & "tane yeni ad eklemek istiyormusunuz", vbYesNo, "SÜTUN ADLARI DEĞİŞTİR") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
    If LCase(Left(fso.getextensionname(fs), 3)) = "xls" Then
        If fs.Name <> ThisWorkbook.Name Then
            Application.DisplayAlerts = False
            If Workbooks.Open(ThisWorkbook.Path & "\" & fs.Name).ReadOnly = True Then
                Workbooks(fs.Name).Close False
            End If
            Application.DisplayAlerts = True
            Range("A1").Value = "album"
            Range("B1").Value = "yorumcuAd"
            Range("C1").Value = "eserAd"
            Range("G1").Value = "calmaSayisi"
            Range("J1").Value = "yil"
            Range("K1").Value = "ay"
            ad = Left(fs.Name, Len(fs.Name) - 4)
            tar = Split(ad, "_")
            sut = 10
            sat = Cells(65536, "A").End(xlUp).Row
            If sat > 1 Then
                For j = LBound(tar) To UBound(tar)
                    Range(Cells(2, sut), Cells(sat, sut)).Value = tar(j)
                    sut = sut + 1
                Next
            End If
            ActiveWorkbook.Close True
        End If
    End If
Next fs
ThisWorkbook.Activate
Application.ScreenUpdating = True
Set fso = Nothing
MsgBox "Sütun adları değişti." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
 

Ekli dosyalar

Evren Gizlen' Alıntı:
Sanırım sayfa adları dosya adı ile ayni.
Peki değiştirilecek verinin ismi nerden alınacak.Hangi sütunda olacak bu isim.
Ve bulunanların nereleri nasıl diğiştirilecek?
Diğer konu ,Sütun başlıklarının değişmesi ve sayfa adının sütun başlığı olarak 2 ilave olması haledikldi.
Diğer dosyalarla ayni klasörde olması lazım.1 kere kulanmanız yetrlidir.
Dosya lar ektedir.Tüm klasör içinde bulunan tüm dosyalarda işlemi yapar.:cool:
Bu dosyaya bakın dönüş yapın sonra diğerleri için devam edicez.:cool:
Kod: 
Sub kolon_basliklrini_degisitr_ekle_59()
Dim sh As Worksheet, fso As Object, fs As Object, ad As String
Dim tar, sut As Byte, j As Byte
If MsgBox("Sayfa'daki sütun adlarını değiştirmek ve 2" _
 & "tane yeni ad eklemek istiyormusunuz", vbYesNo, "SÜTUN ADLARI DEĞİŞTİR") = vbNo Then Exit Sub
Application.ScreenUpdating = False
Set fso = CreateObject("Scripting.FileSystemObject")
For Each fs In fso.getfolder(ThisWorkbook.Path).Files
    If fso.getextensionname(fs) = "xls" Then
        If fs.Name <> ThisWorkbook.Name Then
            Application.DisplayAlerts = False
            If Workbooks.Open(ThisWorkbook.Path & "\" & fs.Name).ReadOnly = True Then
                Workbooks(fs.Name).Close False
            End If
            Application.DisplayAlerts = True
            Range("A1").Value = "album"
            Range("B1").Value = "yorumcuAd"
            Range("C1").Value = "eserAd"
            Range("G1").Value = "calmaSayisi"
            Range("J1").Value = "yil"
            Range("K1").Value = "ay"
            ad = Left(fs.Name, Len(fs.Name) - 4)
            tar = Split(ad, "_")
            sut = 10
            For j = LBound(tar) To UBound(tar)
                Cells(2, sut).Value = tar(j)
                sut = sut + 1
            Next
            If IsNumeric(Range("K2").Value) Then _
            Range("K2").Value = Range("K2").Value * 1
            ActiveWorkbook.Close True
        End If
    End If
Next fs
ThisWorkbook.Activate
Application.ScreenUpdating = True
Set fso = Nothing
MsgBox "Sütun adları değişti." & vbLf & _
"evrengizlen@hotmail.com", vbOKOnly + vbInformation, "E V R E N"
End Sub
Genişletmek için tıkla ...




sayfa adları klasör adı ile aynı değil. zaten tüm excelleri tek klasörde topladım. bir kerede bu kalsördeki tüm excellerde değişiklik yapmak istiyorum. klasör adı farkedermi bilemiyorum. "listeler" diyebiliriz mesela.

fakat yazdığınız kodu çalıştırdım ama 2 tane sheet var ve ne yaptığını anlamadım.

yinede çok teşekkür ederim ama çok karışık geldi. diğer dosyaların olduğu klasöre kaydettim kodunuzu ve çalıştırdım. hiç bişey olmadı. rica etsem benim gönderdiğim dosyalar üzerinde yapabilirmisiniz ki ben çalışıp çalışmadığını anlayabileyim. çünkü makroyu çalıştırınca bişey olmuyo. kendi dosyaslarımıda açınca hiç değişiklik yok maalesef.
 
Son düzenleme:
hrryet' Alıntı:
sayfa adları klasör adı ile aynı değil. zaten tüm excelleri tek klasörde topladım.

fakat yazdığınız kodu çalıştırdım ama 2 tane sheet var ve ne yaptığını anlamadım.

yinede çok teşekkür ederim ama çok karışık geldi. diğer dosyaların olduğu klasöre kaydettim kodunuzu ve çalıştırdım. hiç bişey olmadı. rica etsem benim gönderdiğim dosyalar üzerinde yapabilirmisiniz ki ben çalışıp çalışmadığını anlayabileyim. çünkü makroyu çalıştırınca bişey olmuyo. kendi dosyaslarımıda açınca hiç değişiklik yok maalesef.
Genişletmek için tıkla ...
Ben sayfa adları ile klasör adları aynimi diye sormadım ki zaten.Tespitim sayfa adları ile dosya adları aynimi diye sormuştum.
Sorumu iyi okursanız anlarsınız.
Diğer durum için ise
yolladığım dosyayı kullanacağığnın klasör içine kopyalayınız.
Oradaki butona basınız.Sizin kod ile bir işiniz yok.
Sadece ilk sayfdaki Butona basınız.O işlemi yapacak.Ne yapacak.
Söylemiş olduğunuz sütun adların değiştircek ayrıvca j vbve ksütunlarına ad ekleyecek ve j2 ve k2 hücresine dosyanın adını parçalayıp yazacak.
Dikkat ettiyseniz size yoladığım dosyada bu işlemleri yapmış durumd zaten.
Bu yolladığım dosya sadece bu işlemi yapıyor.
Diğer değişteirme konusu bundan ayrı.Onda daha öncede sordum bilinmezler var.Onları açığıa çıkarınca onuda yapıcam.
Bu dosyaı ve onu 2 ayrı yerde yapmamın sebebpi diğer dosyada her aram ve dğieşitirme yaprtıpğınızda bu sütun adlarınuı yazılmasına gerek yok.Bu işlemi zaten 1 kere yapacaksınız.Veya lazım oldukça yapacaksınız.Onun için 2 ayrı işlem olarak düşündüm ve 2 dosya yapıcam.Bu yolldaığım sadece sütun adların ı değiştiriyor.:cool:
 
Yanlış dosya eklemişim
şimdi doğrusunu yükledim.Ayni yerden indirebilirisiniz.:cool:
 
Kusura bakmayın oruç.. sizin sayfa dediğiniz şey shett'ler doğru ya. birden öyle düşünemedim. Peki bir de söylediğiniz şekilde deniyorum. durumu size bildireceğim.

teşekkür ederim.
 
alternatif kod:
alt klasör dahil


Dim Klasor As Object
Dim Obj As Object
Dim Kaynak As String
Dim Sayfa_Adı As String
Private Sub CommandButton1_Click()
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.browseforfolder(0, Baslik, 50, &H0)
Kaynak = Klasor.Items.Item.Path
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Liste (Klasor.Items.Item.Path)
MsgBox "işlem tamam"
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
Set Obj = Nothing
Set Klasor = Nothing
Exit Sub
Hata: MsgBox Err.Description, vbExclamation, "Error #" & Err.Number
End Sub
Private Sub Liste(Yol As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").getfolder(Yol).SubFolders
Dim wb As Workbook
Dosya = Dir(Yol & "\*.*")
Application.ScreenUpdating = False
While Dosya <> ""
DoEvents
If ThisWorkbook.Name <> Dosya Then
Set wb = Workbooks.Open(Kaynak & "\" & Dosya)
Application.DisplayAlerts = False
dosya_adı = ActiveWorkbook.Name
Sayfa_Adı = ActiveSheet.Name
For r = 1 To ActiveWorkbook.Sheets.Count
sayfaadi = Workbooks(dosya_adı).Sheets(r).Name
Worksheets(sayfaadi).Cells(1, 1).Value = "album"
Worksheets(sayfaadi).Cells(1, 2).Value = "yorumcuAd"
Worksheets(sayfaadi).Cells(1, 3).Value = "eserAd"
Worksheets(sayfaadi).Cells(1, 7).Value = "calmaSayisi"
Worksheets(sayfaadi).Cells(1, 10).Value = "yıl"
Worksheets(sayfaadi).Cells(1, 11).Value = "ay"
On Error Resume Next
deg1 = Sheets(Sheets(r).Name).Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 2 To Val(deg1)
Worksheets(sayfaadi).Cells(i, 10).Value = Format(sayfaadi, "yyyy")
Worksheets(sayfaadi).Cells(i, 11).Value = Format(sayfaadi, "mmmm")
Next i
Next
Application.DisplayAlerts = True
wb.Save
wb.Close False
End If
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
Kaynak = f.Path
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
End Sub
Genişletmek için tıkla ...
 

Ekli dosyalar

Evren Gizlen' Alıntı:
Yanlış dosya eklemişim
şimdi doğrusunu yükledim.Ayni yerden indirebilirisiniz.:cool:
Genişletmek için tıkla ...


Evren Bey diğer makro bana ait olmadığı için olmamış . Şimdi oldu :) Bu kod işimi görecek. tekrar teşekkür ederim.

Fakat hani ay ve yıl kolonunu ekliyoruz ya, onun da içini dolduruyor. onu veri bulunan en son satıra kadar doldurması mümkün olabilir mi? bunu da yapabilir miyiz?
 
hrryet' Alıntı:
Evren Bey diğer makro bana ait olmadığı için olmamış . Şimdi oldu :) Bu kod işimi görecek. tekrar teşekkür ederim.

Fakat hani ay ve yıl kolonunu ekliyoruz ya, onun da içini dolduruyor. onu veri bulunan en son satıra kadar doldurması mümkün olabilir mi? bunu da yapabilir miyiz?
Genişletmek için tıkla ...

5 numaralı mesajda dosyayı ekledim.İstediğiniz düzenlemyi yaptım.:cool:
 
Evren Gizlen' Alıntı:
Yanlış dosya eklemişim
şimdi doğrusunu yükledim.Ayni yerden indirebilirisiniz.:cool:
Genişletmek için tıkla ...

teşekkür ederim. şimdi ki makronuz işime yaradı. istediğim şeyi yapıyor. diğer eklediğinizde bir karışıklık olmuş o nedenle anlayamadım kusura bakmayın.

fakat hani ay ve yıl ekliyor ya, veri olan en son satıra kadar doldurması mümkün olabilir mi?

örneğin aralık dosyası 857 satırda bitiyor. ay ve yıl kolonunu da o satıra kadar doldurabilir miyiz?
 
hrryet' Alıntı:
teşekkür ederim. şimdi ki makronuz işime yaradı. istediğim şeyi yapıyor. diğer eklediğinizde bir karışıklık olmuş o nedenle anlayamadım kusura bakmayın.

fakat hani ay ve yıl ekliyor ya, veri olan en son satıra kadar doldurması mümkün olabilir mi?

örneğin aralık dosyası 857 satırda bitiyor. ay ve yıl kolonunu da o satıra kadar doldurabilir miyiz?
Genişletmek için tıkla ...
Zaten öyle yaptım.Yolladığım dosyayı inceledinizmi?
 
kusura bakmayın ben gönderdiğim cevabı göremeyince aynısını bidaha gönderdim.

evet aldım yeni kodunuzu şu an işimi görüyor istediğim gibi olmuş. emeğinize, bilginize sağlık.

peki bunu bir klasörde 20002e yakın tüm dosyalarda çalıştırabilir miyim yoksa daha az şekilde mi çalıştır malıyım? 50-100 dosya gibi..
 
hrryet' Alıntı:
kusura bakmayın ben gönderdiğim cevabı göremeyince aynısını bidaha gönderdim.

evet aldım yeni kodunuzu şu an işimi görüyor istediğim gibi olmuş. emeğinize, bilginize sağlık.

peki bunu bir klasörde 20002e yakın tüm dosyalarda çalıştırabilir miyim yoksa daha az şekilde mi çalıştır malıyım? 50-100 dosya gibi..
Genişletmek için tıkla ...
Çalıştırabilirsiniz.
Bunu o klasörde deneyin şimdi.
Sonra 2nci soruyu halledelim.:
Denedikten sonra bana dönerseniz iyi olur.Sonuç ne oldu.ne kadar sürede itti gibi.:cool:
 
halit3' Alıntı:
alternatif kod:
alt klasör dahil
Genişletmek için tıkla ...

Sizede çok teşekkür ederim. yazdığınız kod istediğim gibi işimi görüyor. sizden de buna ek olarak şunu rica edebilir miyim. ay ve yıl kolonunu veri bulunan son satıra kadar doldursun. bu da olabilirse kodunuz tam olarak işime yarayacak.

şöyleki mesela aralık dosyası 857 satır ay ve yıl kolonunu o satıra kadar doldursun.

ne olur ne olmaz elimde yedek bir kodun olmasının faydalı olacağını düşünüyorum. çünkü benim işim iiçin bu sistem gerekli ve dosyalarım hergün artıyor.

tekrar teşekkür ederim iyi çalışmalar.
 
Evren Gizlen' Alıntı:
Çalıştırabilirsiniz.
Bunu o klasörde deneyin şimdi.
Sonra 2nci soruyu halledelim.:
Denedikten sonra bana dönerseniz iyi olur.Sonuç ne oldu.ne kadar sürede itti gibi.:cool:
Genişletmek için tıkla ...

denedim ve oldu. tüm dosyalarda en alt satıra kadar ayı ve yılı da ekliyor. başlıkları da ekliyor.3 dosya için 1 dk sürmüyor.

size bir sorum daha olacak ben bu kodu farklı formattaki listelerimdeki başlıkları değiştirmek için de kullanabilir miyim? kodda gerekli kolon başlığı değişikliklerini yaparak?
 
hrryet' Alıntı:
denedim ve oldu. tüm dosyalarda en alt satıra kadar ayı ve yılı da ekliyor. başlıkları da ekliyor.3 dosya için 1 dk sürmüyor.

size bir sorum daha olacak ben bu kodu farklı formattaki listelerimdeki başlıkları değiştirmek için de kullanabilir miyim? kodda gerekli kolon başlığı değişikliklerini yaparak?
Genişletmek için tıkla ...
Ben gerçek yerinde tüm dosyalar için çalıştırıp sonucu iletin anlamında demiştim.Bakalım 2000 dosyada ne performans verecek.Problem varmı gibisinden.
Önemli : bu kodlar hedef dosyalarda aktif sayfaya verilerin yazıldığı şekilde tasarlamıştır.
1 den fazla sayfası olan dosyalarda hangi sayfa aktif ise o sayfaya veriler yazılır.
 
Evren Gizlen' Alıntı:
Ben gerçek yerinde tüm dosyalar için çalıştırıp sonucu iletin anlamında demiştim.Bakalım 2000 dosyada ne performans verecek.Problem varmı gibisinden.
Önemli : bu kodlar hedef dosyalarda aktif sayfaya verilerin yazıldığı şekilde tasarlamıştır.
1 den fazla sayfası olan dosyalarda hangi sayfa aktif ise o sayfaya veriler yazılır.
Genişletmek için tıkla ...

gerçek yerinde çalıştırdım zaten bu dosyalar gerçek olanlar. fakat tamamaında çalıştırmadım çünkü birkaç düzenleme yapmam gerekiyor. mesela 2000 dosyayı tek kalasöre almak gibi. her biri ay ay ayrı ayrı yerlerde. bu da bir kaç günümü alacak maalesef.

ama şu hali gayet yeterli. sonuçta yapacağım şey bu.çok çok teşekür ederim.
takıldığım yer olursa sizden yine bilgi almaktan memnun olurum. iyi çalışmalar,başarılar.
 
Durum
Üzgünüz bu konu cevaplar için kapatılmıştır...
Geri
Üst