Note: The other languages of the website are Google-translated. Back to English

Bir makro birden çok çalışma kitabı dosyasında aynı anda nasıl çalıştırılır?

Bu makalede, bir makroyu birden çok çalışma kitabı dosyasında aynı anda açmadan çalıştırma hakkında konuşacağım. Aşağıdaki yöntem, bu görevi Excel'de çözmenize yardımcı olabilir.

VBA kodu ile birden çok çalışma kitabında aynı anda bir makro çalıştırın


VBA kodu ile birden çok çalışma kitabında aynı anda bir makro çalıştırın

Bir makroyu birden çok çalışma kitabında açmadan çalıştırmak için lütfen aşağıdaki VBA kodunu uygulayın:

1. Basılı tutun ALT + F11 tuşlarını açmak için Uygulamalar için Microsoft Visual Basic pencere.

2. tıklayın Ekle > modülve aşağıdaki makroyu modül Pencere.

VBA kodu: Aynı makroyu aynı anda birden çok çalışma kitabında çalıştırın:

Sub LoopThroughFiles()
    Dim xFd As FileDialog
    Dim xFdItem As Variant
    Dim xFileName As String
    Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
    If xFd.Show = -1 Then
        xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
        xFileName = Dir(xFdItem & "*.xls*")
        Do While xFileName <> ""
            With Workbooks.Open(xFdItem & xFileName)
                'your code here
            End With
            xFileName = Dir
        Loop
    End If
End Sub

not: Yukarıdaki kodda, lütfen kendi kodunuzu kopyalayıp yapıştırın Alt başlık ve End Sub altbilgi Workbooks.Open ile (xFdItem & xFileName) ve İle bitmek Kodlar. Ekran görüntüsüne bakın:

doc makroyu birden çok dosya çalıştır 1

3. Daha sonra tuşuna basın. F5 bu kodu yürütmek için anahtar ve bir Araştır penceresi görüntülenir, lütfen tüm bu makroyu uygulamak istediğiniz çalışma kitaplarını içeren bir klasör seçin, ekran görüntüsüne bakın:

doc makroyu birden çok dosya çalıştır 2

4. Ve sonra tıklayın OK düğmesi, istenen makro bir çalışma kitabından diğerlerine aynı anda yürütülecektir.

 


En İyi Ofis Üretkenliği Araçları

Kutools for Excel Sorunlarınızın Çoğunu Çözer ve Verimliliğinizi% 80 Artırır

  • Yeniden: Hızlıca yerleştirin karmaşık formüller, grafikler ve daha önce kullandığınız her şey; Hücreleri Şifrele şifre ile; Posta Listesi Oluşturun ve e-posta gönder ...
  • Süper Formül Çubuğu (birden çok metin ve formül satırını kolayca düzenleyin); Okuma Düzeni (çok sayıda hücreyi kolayca okuyun ve düzenleyin); Filtrelenmiş Aralığa Yapıştır...
  • Hücreleri / Satırları / Sütunları Birleştirme Veri kaybetmeden; Bölünmüş Hücre İçeriği; Yinelenen Satırları / Sütunları Birleştirme... Yinelenen Hücreleri Önleyin; Aralıkları Karşılaştır...
  • Yinelenen veya Benzersiz'i seçin Satırlar; Boş Satırları Seçin (tüm hücreler boştur); Süper Bul ve Bulanık Bul Birçok Çalışma Kitabında; Rastgele Seçim ...
  • Tam kopya Formül referansını değiştirmeden Birden Çok Hücre; Otomatik Referans Oluştur Birden Çok Sayfaya; Madde İşaretleri Ekle, Onay Kutuları ve daha fazlası ...
  • Metni Çıkar, Metin Ekle, Konuma Göre Kaldır, Alanı Kaldır; Sayfalama Alt Toplamları Oluşturma ve Yazdırma; Hücre İçeriği ve Yorumları Arasında Dönüştür...
  • Süper Filtre (filtre şemalarını kaydedin ve diğer sayfalara uygulayın); Gelişmiş Sıralama ay / hafta / gün, sıklık ve daha fazlasına göre; Özel Filtre kalın, italik ...
  • Çalışma Kitaplarını ve Çalışma Sayfalarını Birleştirin; Tabloları anahtar sütunlara göre birleştirin; Verileri Birden Çok Sayfaya Bölme; Toplu dönüştürme xls, xlsx ve PDF...
  • 300'den fazla güçlü özellik. Office / Excel 2007-2021 ve 365'i destekler. Tüm dilleri destekler. Kuruluşunuzda veya kuruluşunuzda kolay devreye alma. Tam özellikler 30 günlük ücretsiz deneme. 60 günlük para iade garantisi.
kte sekmesi 201905

Office Tab, Office'e Sekmeli Arayüz Getirir ve İşinizi Çok Daha Kolay Hale Getirir

  • Word, Excel, PowerPoint'te sekmeli düzenlemeyi ve okumayı etkinleştirin, Publisher, Access, Visio ve Project.
  • Yeni pencereler yerine aynı pencerenin yeni sekmelerinde birden çok belge açın ve oluşturun.
  • Üretkenliğinizi% 50 artırır ve her gün sizin için yüzlerce fare tıklamasını azaltır!
ofis tabanı

 

Yorumları sıralama ölçütü
Yorumlar (43)
4.5 üzerinden 5 olarak derecelendirildi · 1 derecelendirme
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok kullanışlı bir makro ve iyi çalışıyor, ancak bu klasörden makronun çalıştırılmasını istediğim dosyaları seçebilmek istiyorum. Dosyalar ayrı bir klasörde otomatik olarak oluşturulmaz ve bu klasördeki her dosya kümesinde farklı makrolar çalıştırmam ve ardından bunları ilk klasöre geri taşımam gerekiyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Talimatları takip ettim ancak "Loop wihtout Do" derleme hatası alıyorum. Neyi kaçırıyorum? Makro kodum çok basit, sadece belirtilen satırların yazı tipi boyutunu değiştirin. Kendi kendine çalışır. İşte elimdeki... lütfen yardım edin

Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Yaparken xFileName <> ""
Workbooks.Open ile (xFdItem & xFileName)
'kodunuz burada
Satırlar("2:8").Seç
Selection.Font ile
.Ad = "Arial"
.Boyut = 12
.Üzeri çizili = Yanlış
.Üst simge = Yanlış
.Alt simge = Yanlış
.OutlineFont = Yanlış
.Gölge = Yanlış
.Underline = xlUnderlineStyleYok
.Renk = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
İle bitmek
xFileName = Yön
döngü
Eğer son
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba yarto,
Kodunuzun sonundaki "End with" komut dosyasını kaçırdınız, doğru olan şu olmalıdır:
Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Yaparken xFileName <> ""
Workbooks.Open ile (xFdItem & xFileName)
'kodunuz burada
Satırlar("2:8").Seç
Selection.Font ile
.Ad = "Arial"
.Boyut = 16
.Üzeri çizili = Yanlış
.Üst simge = Yanlış
.Alt simge = Yanlış
.OutlineFont = Yanlış
.Gölge = Yanlış
.Underline = xlUnderlineStyleYok
.Renk = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
İle bitmek
İle bitmek
xFileName = Yön
döngü
Eğer son
End Sub

Lütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Çok kullanışlı bir makro ve harika çalışıyor, ancak bu klasörden makronun çalıştırılmasını istediğim dosyaları seçebilmek istiyorum. Örneğin, diğer excel dosyalarının bulunduğu bir klasörde 4 dosyam var ve sadece bu 4 belirli dosyada çalışmasını istiyorum. Bu klasörden bu 4 dosyayı seçmeme izin vermek için makronuzu nasıl değiştirebilirim?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Joel,
Aynı kodu belirli çalışma kitaplarında tetiklemek için aşağıdaki kodu uygulamanız gerekir:

Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
Dize olarak xFB'yi karart
Application.FileDialog(msoFileDialogOpen) ile
.AllowMultiSelect = Doğru
.Filtreler.Temizle
.Filtreler."excel", "*.xls*" ekleyin
.Göstermek
Eğer .SelectedItems.Count < 1 ise Sub Exit
lngCount için = 1 To .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
Eğer xFileName <> "" O zaman
Workbooks.Open(Dosya Adı:=xDosyaAdı) ile
'senin kodun
İle bitmek
Eğer son
Sonraki lngCount
İle bitmek
End Sub

Lütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
teşekkürler, gerçekten yardımcı oldu
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba!

Kodumu sizin kodunuza eklemeye çalışıyorum ve makroyu çalıştırdığımda bana şu mesajı veriyor: Çalışma zamanı hatası '429': ActiveX nesneyi oluşturamıyor. Lütfen nasıl düzeltilebileceği konusunda tavsiyede bulunun. Teşekkür ederim!

Benim kod:

RInput = Aralık ("A2:A21") olarak ayarlayın
ROutput = Aralık ("D2:D22") olarak ayarlayın

Dim A() Varyant Olarak
ReDim A(1'den RInput.Rows.Count'a, 0)
A = RGiriş.Değer2

Set d = CreateObject("Scripsting.Dictionary")

i = 1 için UBound(A) için
Eğer d.Varsa(A(i, 1)) O zaman
d(A(i, 1)) = d(A(i, 1)) + 1
başka
d.A(i, 1), 1 ekle
Eğer son
Sonraki
i = 1 için UBound(A) için
A(i, 1) = d(A(i, 1))
Sonraki

RÇıkış = A
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, öncelikle bu makro için teşekkür ederim, tam aradığım şeydi. Ancak bir sorunum var, her pencereyi tamamladıkça kapatmanın ve kaydetmenin bir yolu var mı? Çok miktarda dosyam var ve yürütme tamamlanmadan RAM'im bitiyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Evet, dosyayı aynı adla kaydetmesini istiyorsanız, aşağıdaki kodu eklemeniz yeterlidir:

'Çalışma Kitabını Kaydetmek
ActiveWorkbook.Save
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Caitlin,
Belki aşağıdaki kod size yardımcı olabilir, belirli kodunuzu çalıştırdıktan sonra, çalışma kitabını kaydetmenizi hatırlatan bir dosya kaydetme istemi kutusu açılır.

Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
Çalışma kitabı olarak xWB'yi karart
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
On Error Resume Next
Yaparken xFileName <> ""
xWB = Çalışma Kitapları olarak ayarlayın.Open(xFdItem & xFileName)
xWB ile
'kodunuz burada
İle bitmek
xWB.Kapat
xFileName = Yön
döngü
Eğer son
End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba!

Kodumu sizin kodunuza eklemeye çalışıyorum ve makroyu çalıştırdığımda bana şu mesajı veriyor: Çalışma zamanı hatası '429': ActiveX nesneyi oluşturamıyor. Lütfen nasıl düzeltilebileceği konusunda tavsiyede bulunun. Teşekkür ederim!

Benim kod:

RInput = Aralık ("A2:A21") olarak ayarlayın
ROutput = Aralık ("D2:D22") olarak ayarlayın

Dim A() Varyant Olarak
ReDim A(1'den RInput.Rows.Count'a, 0)
A = RGiriş.Değer2

Set d = CreateObject("Scripsting.Dictionary")

i = 1 için UBound(A) için
Eğer d.Varsa(A(i, 1)) O zaman
d(A(i, 1)) = d(A(i, 1)) + 1
başka
d.A(i, 1), 1 ekle
Eğer son
Sonraki
i = 1 için UBound(A) için
A(i, 1) = d(A(i, 1))
Sonraki

RÇıkış = A
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba,

Bu makroyu, her biri kendi kitabı olan 30 takımın NBA dosyalarını biçimlendirmek için başarıyla kullandım. Dün, Modülün (makro) tamamlanamadığını, silinemeyeceğini veya düzenlenemediğini (kaydedilecek) bir hata mesajı aldım. Kişisel makro çalışma kitabımı bozdu ve Excel'i benim için neredeyse kullanılamaz hale getirdi. Herhangi bir dosyadan bir makroya her erişmeye çalıştığımda uygulamayı kilitliyor. Excel desteği ve Windows desteği, bazı şeyleri düzeltme yeteneğine sahip değil. Yardım edebilir misin?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, komut dosyasının kendisinde dosya hedefini tanımlayabilmemin bir yolu var mı? Belirli klasöre göz atmamız gereken 3. işlemi atlamak istiyorum.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu kod için teşekkürler. tüm çalışma kitaplarını tek bir sayfada açtığım makromun sonucunu (arka arkaya her çalışma kitabının sonucu) nasıl alabileceğimi söyler misiniz? ve önceki adımdaki verilerle satıra her çalışma kitabının adını eklemenin bir yolu var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Hi

1004 çalışma zamanı hatası aldım: Office VBA'yı Genişletin "Office VBA'yı Genişlet" ile "VBA koduyla birden çok çalışma kitabında aynı anda bir makro çalıştır" için aşağıdaki kodu çalıştırdığımda sözdizimi doğru değil Adlandırılmış tüm aralıkları sil VBA koduyla" kod yuvanızı yerleştirin:

Alt LoopThroughFiles()

xFd'yi FileDialog Olarak Kısma

Varyant Olarak Dim xFdItem

Dize Olarak xFileName Dim

xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)

xFd.Show = -1 ise

xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator

xFileName = Dir(xFdItem & "*.xls*")

Yaparken xFileName <> ""

Workbooks.Open ile (xFdItem & xFileName)

' Alt Silİsimler()

'20140314 güncellemesi

Dim xName Ad Olarak

Application.ActiveWorkbook.Names'deki Her xName için

xName.Delete

Sonraki


İle bitmek

xFileName = Yön

döngü

Eğer son

End Sub

Yapmaya çalıştığım, aynı klasörde bulunan sekiz çalışma kitabındaki adlandırılmış aralıkları silen bir makro çalıştırmak.

BTW, Extend Office'ten ilk kez bir şey kullandım ve işe yaramadı. Bu web sitesi bana son derece yardımcı oldu.

Öneriler/yorumlar çok takdir edilecektir.

aldc
Bu yorum sitedeki moderatör tarafından en aza indirildi
merhaba alc,
Kodunuz çalışma kitabımda iyi çalışıyor, hangi Excel sürümünü kullanıyorsunuz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu kod çok iyi ve kullanışlıdır. Onu çok kullanırım!

Günümüzde, kuruluşumda artık dosyalarımızı depolamak için SharePoint kullanıyoruz. Bu kodun bir sharepoint klasöründeki tüm dosyalarda çalışmasını sağlamanın bir yolu var mı?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu kod için teşekkürler.
Alt klasörler arasında da dolaşmanın bir yolu var mı? Diyelim ki bir klasörüm var ve klasörün içinde her biri bir excel dosyası içeren on klasör daha var.

Kodun tüm alt klasörlerinden geçmesi için yalnızca birincil klasörü seçmenin bir yolu var mı?

Teşekkür ederim.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Darko, Alt klasörleri olan bir klasörden kod çalıştırmak için lütfen aşağıdaki kodu uygulayın: Alt LoopThroughFiles_Subfolders(xStrPath As String)
Dim xSolderName
xDosyaAdı'nı karart
Dim xArrSFPath() Dize Olarak
Tamsayı Olarak Dim xI
xStrPath = "" ise, Sub'dan Çıkın
xFileName = Dir(xStrPath & "*.xls*")
Yaparken xFileName <> ""
Workbooks.Open(xStrPath & xFileName) ile
'kodunuz burada
İle bitmek
xFileName = Yön
döngü
xSolderName = Dir(xStrPath, vbDirectory)
0 = XNUMX
ReDim xArrSFPath(0)
xSfolderName Yaparken <> ""
Eğer xSfolderName <> "." Ve xSFolderName <> ".." Sonra
Eğer (GetAttr(xStrPath & xSFolderName) Ve vbDirectory) = vbDirectory
xI = xI + 1
ReDim xArrSFPath(xI) Koru
xArrSFPath(xI - 1) = xStrPath & xSolderName & "\"
Eğer son
Eğer son
xSfolderName = Yön
döngü
UBound(xArrSFPath) > 0 ise
xI = 0 için UBound(xArrSFPath) için
LoopThroughFiles_Subfolders (xArrSFPath(xI))
Sonraki xI
Eğer son
End Sub
Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Eğer son
End SubLütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Yukarıdaki koda ek olarak excel dosyalarını istediğim kronolojik sırayla açmak mümkün müdür?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, öncelikle çalışmak için gerçekten kullanışlı olan makro için çok teşekkürler. Tek sürücüdeki klasörü makro aracılığıyla yenilemenin bir yolu olup olmadığını merak ediyordum. Cevabınız evet ise, lütfen makro komut dosyasını kullanarak onedrive'daki dosyaları yenilemek için burada ne yapabileceğimi bana bildirin.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, bu komut dosyası için çok teşekkürler, benim için çok iyi çalışıyor, ancak özel ihtiyaçlarım var: Kodumu dosya adı koşullarıyla VE alt klasörlerde uygulamak için komut dosyasını değiştirmenin bir yolu var mı?
Açıklıyorum: Ben bir öğretmenim ve öğrencilerin sonuçlarını kaydetmek ve öğretmenlerin onlara danışmasına izin vermek için bir excel çözümü oluşturdum. Bunu yapmak için, her sınıf için bir klasörde olmak üzere okul subjet başına bir dosyam ve sınıf sorumlusu için bir dosyam var.
Bu yüzden bir hata veya optimizasyon bulduğumda, tüm alt klasörlerdeki tüm dosyalardaki değişiklikleri bildirmem gerekiyor.
Ancak tüm dosyalar aynı olmadığı için (farklı subjets organizasyonu), tüm alt klasörlerdeki "matematik sınıfı" adlı tüm dosyalara kod par örneğimi uygulamanın bir yolunu istiyorum veya kodumu tüm dosyalara uygulamak için "xyz" adlı tüm dosyalar hariç alt klasörlerde.Teşekkürler !Fabrice
Bu yorum sitedeki moderatör tarafından en aza indirildi
Verilen kodunuz aşağıdaki VBA ile çalışmıyor, lütfen helpSub Bundles()

Çalışma Sayfası Olarak Dim vWS
Karartma vA, vA2()
Dim vR Kadar Uzun, vSum Kadar Uzun, vC Kadar Uzun
vN Kadar Uzun, vN2 Kadar Uzun, vN3 Kadar Uzun

vWS'yi ayarla = ActiveSheet
vWS ile
vR = .Cells(Rows.Count, 4).End(xlUp).Satır
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Koru vA2(1'den vSum'a, 1'den 4)
vA = .Range("A2:D" & vR)
vN = 1 için vR - 1
vN2 için = 1'den vA'ya(vN, 4)
vC = vC + 1
vN3 için = 1 ila 4
vA2(vC, vN3) = vA(vN, vN3)
Sonraki vN3
Sonraki vN2
Sonraki vN
İle bitmek
vC = 1
vN için = 1'den vSum'a - 2
vA2(vN, 4) = vC
vA2(vN + 1, 2) = vA2(vN, 2) ise
vC = vC + 1
vA2(vN + 1, 4) = vC
başka
vA2(vN + 1, 4) = 1
vC = 1
Eğer son
Sonraki vN
Application.ScreenUpdating = Yanlış
Sheets.Add
ActiveSheet ile
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Hücreler(2, 1).Yeniden Boyutlandır(vSum, 4) = vA2
İle bitmek
Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu VBA'yı bir seferde bir klasördeki birden çok Sayfada çalıştırmak istiyorum, lütfen helpSub Bundles()

Çalışma Sayfası Olarak Dim vWS
Karartma vA, vA2()
Dim vR Kadar Uzun, vSum Kadar Uzun, vC Kadar Uzun
vN Kadar Uzun, vN2 Kadar Uzun, vN3 Kadar Uzun

vWS'yi ayarla = ActiveSheet
vWS ile
vR = .Cells(Rows.Count, 4).End(xlUp).Satır
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Koru vA2(1'den vSum'a, 1'den 4)
vA = .Range("A2:D" & vR)
vN = 1 için vR - 1
vN2 için = 1'den vA'ya(vN, 4)
vC = vC + 1
vN3 için = 1 ila 4
vA2(vC, vN3) = vA(vN, vN3)
Sonraki vN3
Sonraki vN2
Sonraki vN
İle bitmek
vC = 1
vN için = 1'den vSum'a - 2
vA2(vN, 4) = vC
vA2(vN + 1, 2) = vA2(vN, 2) ise
vC = vC + 1
vA2(vN + 1, 4) = vC
başka
vA2(vN + 1, 4) = 1
vC = 1
Eğer son
Sonraki vN
Application.ScreenUpdating = Yanlış
Sheets.Add
ActiveSheet ile
vWS.Range("A1:D1").Copy .Range("A1:D1")
.Hücreler(2, 1).Yeniden Boyutlandır(vSum, 4) = vA2
İle bitmek
Application.ScreenUpdating = True

End Sub
Bu yorum sitedeki moderatör tarafından en aza indirildi
Kodu çalıştırmayı denedim ama "With Workbooks.Open(xFdItem & xFileName)" satırında "424 : Object Required" hatası görünüyor. Daha derine bakıldığında, ilgilenilen klasörde saklanan excels çalışma kitaplarının görüntülenmediği/mevcut olmadığı (kod ekranı ile pencere açıldığında, klasörü açmaya çalışırsam ve seçmemeye çalışırsam, boştur). Nasıl yani?
Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Yaparken xFileName <> ""
Workbooks.Open ile (xFdItem & xFileName)
Sheets.Add After:=ActiveSheet
Sayfalar("Sayfa2").Seçin
Sayfalar("Sayfa2").Ad = "Ana"
Sayfalar("Ana").Seçin
Sayfalar("Kalıp").Önceye Taşı:=E-Tablolar(1)
İle bitmek
xFileName = Yön
döngü
Eğer son
End Sub


Lütfen bu sorunu çözmeme yardım eder misiniz?
Bu yorum sitedeki moderatör tarafından en aza indirildi
Bu, kesinlikle en net talimatlara sahip en sevdiğim web sitesidir (herhangi bir YouTube videosundan daha fazla) ve tekrar tekrar geri gelmeye devam ediyorum. Bu eğitimler için çok teşekkür ederim - sen üzgün bir yüksek lisans öğrencisinin cankurtaransın.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
Yaparken xFileName <> ""
Workbooks.Open ile (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
İle bitmek
xFileName = Yön
döngü
Eğer son
End Sub, lütfen yardım edin. BTW, excel dosya uzantım (.csv - "virgülle ayrılmış") . ve bir klasörde her satırda ortalama 500 satır sayısı olan 500000 excel dosyam var .. Lütfen Yardım Edin . Sadece her çalışma kitabına sütun eklemek istiyorum
Bu yorum sitedeki moderatör tarafından en aza indirildi
Sorunuza hiç cevap aldınız mı? Aynı şeyi 3700'den fazla csv dosyasına yapmaya çalışıyorum. Sadece 1 sütun (A) eklemem gerekiyor.
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, muhtaç ve Carly, Sorununuzu çözmek için, birden fazla CSV dosyası için kodu çalıştırmak için, aşağıdaki kodda gösterildiği gibi .xls dosya uzantısını .csv olarak değiştirmeniz yeterlidir: Alt LoopThroughFiles()
xFd'yi FileDialog Olarak Kısma
Varyant Olarak Dim xFdItem
Dize Olarak xFileName Dim
xFd olarak ayarlayın = Application.FileDialog(msoFileDialogFolderPicker)
xFd.Show = -1 ise
xFdItem = xFd.SelectedItems(1) ve Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
Yaparken xFileName <> ""
Workbooks.Open ile (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A").EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
İle bitmek
xFileName = Yön
döngü
Eğer son
End SubLütfen deneyin, umarım size yardımcı olabilir!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba, makroyu yalnızca belirli bir adla farklı çalışma kitaplarının sayfalarında çalıştırmak mümkün müdür? Teşekkürler!!
Bu yorum sitedeki moderatör tarafından en aza indirildi
Merhaba Sara,
Üzgünüz, belirttiğiniz sorunun iyi bir çözümü yok.
Teşekkür ederim!
Buraya henüz hiç yorum yapılmamış
Daha Çok
Lütfen yorum yazın
Misafir olarak yayınlama
×
Bu gönderiyi değerlendirin:
0   Karakterler
Önerilen Konumlar

Bizi takip et

Telif Hakkı © 2009 - www.extendoffice.com. | Tüm hakları Saklıdır. Tarafından desteklenmektedir ExtendOffice. | | | Site Haritası
Microsoft ve Office logosu, Microsoft Corporation'ın Amerika Birleşik Devletleri ve / veya diğer ülkelerdeki ticari markaları veya tescilli ticari markalarıdır.
Sectigo SSL ile korunmaktadır