Excel Vba Forum - Excelce.Net
SORU ve CEVAPLAR (Yazılabilir) => Microsoft Excel, Vba, Makro, Formül vb. Soruları => Konuyu başlatan: mermer - 19 Mayıs 2020, 15:53:11
-
Merhaba arkadaşalr yeni VBA öğrenmeye başladım. Acemiyim çok kısa bir sorum olacak. Daha tam bitiremedim çünkü takıldım. Şimdi, Elimde ürünlerin markalarına ait onlarca csv dosyası var ARCLK BEKO GURUİNDG VBE... isimlerde Aşağıdaki gibi bir şey yazdım.
Kod Arclk csv doyasını açıyor ";" le ayrılmış csv dosyasında metni sutunlara dönüştürüyor, en baş 2. ve 3. sıraya iki satır ekliyor, eklenen iki satıra satır başlıkları ve değerlerini ekliyor, tablonun tümünü kopyalıyor ve aktif excel sayfasına satırları sutunlara dönüşterecek şekilde ters yapıştırıyor.
Ama gördüğünüz gibi diğer dosya için aynı işlemi yapmak için Arclk yazan her değerin YENİ DOSYA ADIYLA DEĞİŞTİRİLMESİ gerekiyor.
Ayrıca son kopyalama işlemi hep aynı sayfaya yapılıyor
Şimdi yapmak istediğim For each next ya da for next döngüsüyle elimdeki .csv dosyalarının ismin yazdığı listeyi bu koda tanıtmak ve döngü her takraladığında Arclk değerinin vestl , vestl değerinin gurinding yani mevcut değrlerin(ARCLK) listedeki diğer değerlere(vestl) dönüşerek kodun tekrar etmesi ve mevcut excel çalışma kitabında yeni sayfa açarak sorgulama yaptığı değer (arclk, VSTL VS ) ismiyle yeni sayfada kaydetmesi.... Yeni sayfa ismiyle yazdırma olayını araştırıyorum onu kotarabilirim sanki :) ama bu kodları bir .csv dosyası isim listesine bağlı döngüye sokup her işlemde ÖRNEĞİN kodlarda nerde ARCLK yazıyorsa onu VESTLL olrak değişerek sorgulamanın listedeki dosya isimelri bitine kadar tekrar etmesini halledebileceğimi sanmıyorum yardımcı olur musunuz.
Sub er()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Toplu")
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\ARCLK.csv")
Sheets("ARCLK").Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
Sheets("ARCLK").Rows("2:2").Insert Shift:=xlDown
Sheets("ARCLK").Rows("3:3").Insert Shift:=xlDown
Sheets("ARCLK").Cells(2, 1) = "ÜRÜN ADI"
Sheets("ARCLK").Range("B2:AW2") = "ARCLK"
Sheets("ARCLK").Range("A1").CurrentRegion.Copy
Sheets.Add After:=Activesheets.Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks("ARCLK.csv").Save
Workbooks("ARCLK.csv").Close
End Sub
-
Merhaba,
Farklı dosyaları sırayla açıp, işlem yapıp, kapatmak için dosya isimlerini bir döngü ile almanız gerekiyor.
Sizin kodunuz:
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\ARCLK.csv")
Örnek döngü kodu:
For dosya=1 to dosyasayisi
dosyaadi=dosyam(dosya)
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\" & dosyaadi & ")"
Next dosya
Yukarıdaki döngü içine diğer kodlarınızı da eklemeniz ve ek olarak da döngüde seçilen dosya adında sayfa eklemeniz ve verileri de bu sayfaya almanız gerekiyor.
Yani sabit kodunuzdaki değerleri döngü ile değişkenlere atayarak işlem yapmanız gerekiyor.
-
Elimde bir onlarca .csv uzantılı dosya için tek tek o yerleri bulup değiştirmem gerekiyor :) elle csv soya isimleri ARCLK, VESTL, GURNDİNG, BEKO, BOSH vs diye uzayıp gidiyor işte csv dosya isim listesi oluşturup bu isimleri bir değişkene atayıp döngüyle ilgili yerlerin değişmesini nasıl sağlayabilirim :) bu konuda hiç bir fikrim yok, değiiken atayıp listeyi gösterdikten sonra for each next ya da for next dögüsü ile bunun yapılabileceğini tahmin ediyorum ama henüz bunu yapabilecek yetenekte değilim :)
-
hatta bakın 2 satıur eklemek için aynı kldou iki ketre yazdım muhakkak daha kolay bir yolu vardır mesala :)
Sheets("ARCLK").Rows("2:2").Insert Shift:=xlDown
Sheets("ARCLK").Rows("3:3").Insert Shift:=xlDown
henüz acem,iyim yardımcı olur musunuz.
-
Merhaba,
Farklı dosyaları sırayla açıp, işlem yapıp, kapatmak için dosya isimlerini bir döngü ile almanız gerekiyor.
Sizin kodunuz:
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\ARCLK.csv")
Örnek döngü kodu:
For dosya=1 to dosyasayisi
dosyaadi=dosyam(dosya)
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\" & dosyaadi & ")"
Next dosya
Yukarıdaki döngü içine diğer kodlarınızı da eklemeniz ve ek olarak da döngüde seçilen dosya adında sayfa eklemeniz ve verileri de bu sayfaya almanız gerekiyor.
Yani sabit kodunuzdaki değerleri döngü ile değişkenlere atayarak işlem yapmanız gerekiyor.
dosyaadi=dosyam(dosya) burda dosyam(dosya) olarak listeyi nasıl gösterebilirim ki o listeyi döngülesin :) o kısmı anlamakta yapmak ta zorlanıyorum
-
Merhaba,
Farklı dosyaları sırayla açıp, işlem yapıp, kapatmak için dosya isimlerini bir döngü ile almanız gerekiyor.
Yukarıdaki döngü içine diğer kodlarınızı da eklemeniz ve ek olarak da döngüde seçilen dosya adında sayfa eklemeniz ve verileri de bu sayfaya almanız gerekiyor.
Yani sabit kodunuzdaki değerleri döngü ile değişkenlere atayarak işlem yapmanız gerekiyor.
benim yapadığım kısmı çok iyi tespit edip anlatmışsınız :) işte yapadığım kısım anlattığınız kısım youtube forumlar vs sabah 6 da başlayıp şu ana kadara yazabildiğim noktaya kadar geldim ama döngü olayınıda tıkandım yardımcı olur musnuz
-
arclk, VSTL vb.
Bu dosyalarınızın hepsi tek bir klasörde mi bulunuyor?
O klasörde başka dosya var mı/olacak mı?
-
evet csv lerin hepsi me dosyasında duruyor mailden indirdiğim dosyalar orda mevcut csv ler haricin dosya olamayacak ama koddan sonara kaydedilen dosyaların ayrı bir kalsöre kaydedilmesi gerek bunun üztesinden glebilirsem sayenizde büyük bir iş yükünden kurtulm uş olacağım :) bir kere öğerensem onu modelelyerek fdarklı atraksiyonlerı kotarabilirm lakin önce bir ustadan çıaraklık odellemesi alamk gerek bunu nasıl analdım 6 adan beri yüzdelrce vidfeo izledim onalarca forum dolaştım olmuyor olmuyor şu sizin anlattığınız oalyı kotaramadım :)
-
arclk, VSTL vb.
Bu dosyalarınızın hepsi tek bir klasörde mi bulunuyor?
O klasörde başka dosya var mı/olacak mı?
burda ayrı çalışma sayfası olarak duran csv lerin tek bir excel dosyasında ayrı sayfalar olarak bir araya getirebilmeyi de sağşlamış olacağım :) yardımcı olursanbız
-
Adım adım yardımcı olmaya çalışayım size...
Aşağıdaki kod ile istediğiniz klasördeki dosyaları sırayla açtırabilirsiniz:
Sub klasorde_dosya_ara()
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> ""
Application.Workbooks.Open "C:\Excelce\" & dosyaadi
dosyaadi = Dir
Wend
End Sub
Klasör yolunu kendinize uyarlamanız gerekiyor.
-
Kodu biraz daha geliştirirsek:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
dosyaadi = Dir
Wend
Yukarıdaki şekilde, klasördeki dosyaları sırayla açıyor ve mevcut dosyamızda o isimde bir sayfa ekliyoruz.
Aşağıdaki koda ise sizin kodların entegre edilmesi örneğini görebilirsiniz:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
'Sizin yaptırdığınız işlemler:
ActiveSheet.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
ActiveSheet.Rows("2:2").Insert Shift:=xlDown
ActiveSheet.Rows("3:3").Insert Shift:=xlDown
ActiveSheet.Cells(2, 1) = "ÜRÜN ADI"
ActiveSheet.Range("B2:AW2") = "ARCLK"
ActiveSheet.Range("A1").CurrentRegion.Copy
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
ThisWorkbook.Sheets(dosyaadi).Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks(dosyaadi).Close , False 'açtığımız dosyayı kaydetmeden kapatıyoruz
dosyaadi = Dir
Wend
Bu arada, daha sağlıklı kontrol için örnek csv'lerden bir tane ekleyebilir misiniz?
-
Kusura bakmayın malum corana zmanı keratalar başımızda yumurcakjlar rahat durmadıkalrı için göz kulak olmak zorunda kaldım :))
-
Kodu biraz daha geliştirirsek:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
dosyaadi = Dir
Wend
Yukarıdaki şekilde, klasördeki dosyaları sırayla açıyor ve mevcut dosyamızda o isimde bir sayfa ekliyoruz.
Aşağıdaki koda ise sizin kodların entegre edilmesi örneğini görebilirsiniz:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
'Sizin yaptırdığınız işlemler:
ActiveSheet.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
ActiveSheet.Rows("2:2").Insert Shift:=xlDown
ActiveSheet.Rows("3:3").Insert Shift:=xlDown
ActiveSheet.Cells(2, 1) = "ÜRÜN ADI"
ActiveSheet.Range("B2:AW2") = "ARCLK"
ActiveSheet.Range("A1").CurrentRegion.Copy
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
ThisWorkbook.Sheets(dosyaadi).Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks(dosyaadi).Close , False 'açtığımız dosyayı kaydetmeden kapatıyoruz
dosyaadi = Dir
Wend
Bu arada, daha sağlıklı kontrol için örnek csv'lerden bir tane ekleyebilir misiniz?
bu kodu deneyeceğim BİR TEK ARCLK YAZAN KISIM NASIL VESTEL İ KAYDEDERKEN ORASININ VESTEL OLAMASI GEREKEMEZ Mİ
-
Kodu biraz daha geliştirirsek:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
dosyaadi = Dir
Wend
Aşağıdaki koda ise sizin kodların entegre edilmesi örneğini görebilirsiniz:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
'Sizin yaptırdığınız işlemler:
ActiveSheet.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
ActiveSheet.Rows("2:2").Insert Shift:=xlDown
ActiveSheet.Rows("3:3").Insert Shift:=xlDown
ActiveSheet.Cells(2, 1) = "ÜRÜN ADI"
ActiveSheet.Range("B2:AW2") = "ARCLK"
ActiveSheet.Range("A1").CurrentRegion.Copy
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
ThisWorkbook.Sheets(dosyaadi).Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks(dosyaadi).Close , False 'açtığımız dosyayı kaydetmeden kapatıyoruz
dosyaadi = Dir
Wend
Bu arada, daha sağlıklı kontrol için örnek csv'lerden bir tane ekleyebilir misiniz?
Dir("C:\Excelce\" BU BAĞLANTI CSV dosyalrının olduğu kLasör olARAK DEĞİŞECEK DEĞİL Mİ
BU KODLAR FOR DÖNGÜSÜ OLMADAN BUNU YAPABİLİYOR GERÇEKTEN HAYRET VERİCİ :) yanına açıklama yazarmasınız diyecek yüzük yok :) ama öğrebneceğim bu işi çabalaıyorum
-
DOSYA ADI KISMINI DEĞİŞTİRDİM "C:\Users\XXXX\Desktop\me" CSV LERİN İÇİNDE OLDUĞU KLASÖRÜN ADINI YAPIYORUM AMA ORDA HATA VERİYOR CSVLER ME KLASÖRÜNDE
-
DOSYA ADI KISMINI DEĞİŞTİRDİM "C:\Users\XXXX\Desktop\me" CSV LERİN İÇİNDE OLDUĞU KLASÖRÜN ADINI YAPIYORUM AMA ORDA HATA VERİYOR CSVLER ME KLASÖRÜNDE
Tamamen büyük harfle yazmayalım lütfen.
"C:\Users\XXXX\Desktop\me" yi "C:\Users\XXXX\Desktop\me\" şeklinde yapar mısınız?
While dosyaadi <> ""
Bu da bir döngüdür. Dosya bulamayana kadar devam eder.
Döngü çeşitlerini internetten araştırabilirsiniz.
Örnekler: http://excelvba.net/viewtopic.php?f=63&t=625 (http://excelvba.net/viewtopic.php?f=63&t=625)
-
üstat şöyle bir uayrı alıyorum nerde hata yapıyrum ki :(
(https://i.ibb.co/LNDZdD1/vbb.jpg) (https://ibb.co/Vw0qY0T)
-
ÜSTAT kodun çalışan son şekli elimden bu kadar geldi bir exel sayfasında bul değiştirle ARCLK isimlerini vestl bosh vs yapıp alt altalta copy paste yapacam kodları başka çarem kalmadı :( 367 tane csv var biarz uğraştıracak ama olsun başka çarem kalmadı
-
Sub TT()
ThisWorkbook.Sheets.Add.Name = "ARCLK"
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("ARCLK")
Application.Workbooks.Open ("C:\Users\xxxxx\Desktop\me\ARCLK.csv")
Sheets("ARCLK").Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
Sheets("ARCLK").Rows("2:2").Insert Shift:=xlDown
Sheets("ARCLK").Rows("3:3").Insert Shift:=xlDown
Sheets("ARCLK").Cells(2, 1) = "Hisse Adı"
Sheets("ARCLK").Cells(3, 1) = "Para Birimi"
Sheets("ARCLK").Range("B2:AW2") = "ARCLK"
Sheets("ARCLK").Range("B3:AW3") = "TL"
Sheets("ARCLK").Range("A1").CurrentRegion.Copy
sh.Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks("ARCLK.csv").Save
Workbooks("ARCLK.csv").Close
End Sub
-
Kodu biraz daha geliştirirsek:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
dosyaadi = Dir
Wend
üstat sayende hallettim :) yaptığım hata \ iki tane doysa yolunun 1. sine \ imleci koymak ikincisine koymamakmış Çok sağol Allah ne muradın varsa versin aklıma geldikçe hep duacınım beni büyük bir yüketn kurtardın
Yukarıdaki şekilde, klasördeki dosyaları sırayla açıyor ve mevcut dosyamızda o isimde bir sayfa ekliyoruz.
Aşağıdaki koda ise sizin kodların entegre edilmesi örneğini görebilirsiniz:
Dim dosyaadi As String
dosyaadi = Dir("C:\Excelce\")
While dosyaadi <> "" 'Klasör içinde dosya ara
Application.Workbooks.Open "C:\Excelce\" & dosyaadi ' Sırayla dosyaları aç
'Sizin yaptırdığınız işlemler:
ActiveSheet.Range("A1").CurrentRegion.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, Semicolon:=True
ActiveSheet.Rows("2:2").Insert Shift:=xlDown
ActiveSheet.Rows("3:3").Insert Shift:=xlDown
ActiveSheet.Cells(2, 1) = "ÜRÜN ADI"
ActiveSheet.Range("B2:AW2") = "ARCLK"
ActiveSheet.Range("A1").CurrentRegion.Copy
ThisWorkbook.Sheets.Add(After:=Worksheets(Worksheets.Count)).Name = dosyaadi 'Açılan dosya adında sayfa ekle
ThisWorkbook.Sheets(dosyaadi).Range("A1").PasteSpecial xlPasteValues, Transpose:=True
Workbooks(dosyaadi).Close , False 'açtığımız dosyayı kaydetmeden kapatıyoruz
dosyaadi = Dir
Wend
Bu arada, daha sağlıklı kontrol için örnek csv'lerden bir tane ekleyebilir misiniz?
-
üstat sayende hallettim :) yaptığım hata \ iki tane doysa yolunun 1. sine \ imleci koymak ikincisine koymamakmış Çok sağol Allah ne muradın varsa versin aklıma geldikçe hep duacınım beni büyük bir yüketn kurtardın
-
Yardımcı olabildiğime sevindim.
Çalışmalarınızda başarılar. :cicek1