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

วิธีเรียกใช้แมโครในเวลาเดียวกันในไฟล์สมุดงานหลายไฟล์

บทความนี้ฉันจะพูดถึงวิธีเรียกใช้แมโครในไฟล์สมุดงานหลายไฟล์ในเวลาเดียวกันโดยไม่ต้องเปิด วิธีการต่อไปนี้สามารถช่วยคุณแก้ปัญหานี้ใน Excel

เรียกใช้แมโครพร้อมกันในสมุดงานหลายเล่มด้วยรหัส VBA


เรียกใช้แมโครพร้อมกันในสมุดงานหลายเล่มด้วยรหัส VBA

หากต้องการเรียกใช้แมโครในสมุดงานหลายเล่มโดยไม่ต้องเปิดโปรดใช้รหัส VBA ต่อไปนี้:

1. กด ALT + F11 คีย์เพื่อเปิด Microsoft Visual Basic สำหรับแอปพลิเคชัน หน้าต่าง

2. คลิก สิ่งที่ใส่เข้าไป > โมดูลและวางมาโครต่อไปนี้ในไฟล์ โมดูล หน้าต่าง.

รหัส VBA: เรียกใช้แมโครเดียวกันบนสมุดงานหลายเล่มในเวลาเดียวกัน:

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

หมายเหตุ: ในรหัสด้านบนโปรดคัดลอกและวางรหัสของคุณเองโดยไม่มีไฟล์ หัวเรื่องและ ย่อยสิ้นสุด ส่วนท้ายระหว่าง ด้วย Workbooks.Open (xFdItem & xFileName) และ จบด้วย สคริปต์ ดูภาพหน้าจอ:

doc เรียกใช้มาโครหลายไฟล์ 1

3. จากนั้นกด F5 กุญแจสำคัญในการรันโค้ดนี้และไฟล์ หมวดหมู่สินค้า หน้าต่างจะปรากฏขึ้นโปรดเลือกโฟลเดอร์ที่มีสมุดงานที่คุณต้องการให้ทุกคนใช้มาโครนี้ดูภาพหน้าจอ:

doc เรียกใช้มาโครหลายไฟล์ 2

4. จากนั้นคลิก OK มาโครที่ต้องการจะดำเนินการพร้อมกันจากสมุดงานหนึ่งไปยังสมุดงานอื่น ๆ

 


เครื่องมือเพิ่มประสิทธิภาพการทำงานในสำนักงานที่ดีที่สุด

Kutools สำหรับ Excel ช่วยแก้ปัญหาส่วนใหญ่ของคุณและเพิ่มผลผลิตของคุณได้ถึง 80%

  • นำมาใช้ใหม่: ใส่อย่างรวดเร็ว สูตรที่ซับซ้อนแผนภูมิ และสิ่งที่คุณเคยใช้มาก่อน เข้ารหัสเซลล์ ด้วยรหัสผ่าน; สร้างรายชื่อผู้รับจดหมาย และส่งอีเมล ...
  • ซุปเปอร์ฟอร์มูล่าบาร์ (แก้ไขข้อความและสูตรหลายบรรทัดได้อย่างง่ายดาย); การอ่านเค้าโครง (อ่านและแก้ไขเซลล์จำนวนมากได้อย่างง่ายดาย); วางลงในช่วงที่กรองแล้ว...
  • ผสานเซลล์ / แถว / คอลัมน์ โดยไม่สูญเสียข้อมูล แยกเนื้อหาของเซลล์ รวมแถว / คอลัมน์ที่ซ้ำกัน... ป้องกันเซลล์ซ้ำ; เปรียบเทียบช่วง...
  • เลือกซ้ำหรือไม่ซ้ำ แถว; เลือกแถวว่าง (เซลล์ทั้งหมดว่างเปล่า); Super Find และ Fuzzy Find ในสมุดงานจำนวนมาก สุ่มเลือก ...
  • สำเนาถูกต้อง หลายเซลล์โดยไม่เปลี่ยนการอ้างอิงสูตร สร้างการอ้างอิงอัตโนมัติ ถึงหลายแผ่น ใส่สัญลักษณ์แสดงหัวข้อย่อย, กล่องกาเครื่องหมายและอื่น ๆ ...
  • แยกข้อความ, เพิ่มข้อความ, ลบตามตำแหน่ง, ลบ Space; สร้างและพิมพ์ผลรวมย่อยของเพจ แปลงระหว่างเนื้อหาของเซลล์และความคิดเห็น...
  • ซุปเปอร์ฟิลเตอร์ (บันทึกและใช้โครงร่างตัวกรองกับแผ่นงานอื่น ๆ ); การเรียงลำดับขั้นสูง ตามเดือน / สัปดาห์ / วันความถี่และอื่น ๆ ตัวกรองพิเศษ โดยตัวหนาตัวเอียง ...
  • รวมสมุดงานและแผ่นงาน; ผสานตารางตามคอลัมน์สำคัญ แยกข้อมูลออกเป็นหลายแผ่น; Batch แปลง xls, xlsx และ PDF...
  • คุณสมบัติที่ทรงพลังมากกว่า 300 รายการ. รองรับ Office / Excel 2007-2019 และ 365 รองรับทุกภาษา ใช้งานง่ายในองค์กรหรือองค์กรของคุณ ทดลองใช้ฟรี 30 วันเต็ม รับประกันคืนเงิน 60 วัน
kte แท็บ 201905

แท็บ Office นำอินเทอร์เฟซแบบแท็บมาที่ Office และทำให้งานของคุณง่ายขึ้นมาก

  • เปิดใช้งานการแก้ไขและอ่านแบบแท็บใน Word, Excel, PowerPoint, ผู้จัดพิมพ์, Access, Visio และโครงการ
  • เปิดและสร้างเอกสารหลายรายการในแท็บใหม่ของหน้าต่างเดียวกันแทนที่จะเป็นในหน้าต่างใหม่
  • เพิ่มผลผลิตของคุณ 50% และลดการคลิกเมาส์หลายร้อยครั้งให้คุณทุกวัน!
ด้านล่าง officetab

 

จัดเรียงความคิดเห็นโดย
ความคิดเห็น (39)
ได้รับคะแนน 4.5 จาก 5 · การจัดอันดับ 1
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มาโครที่มีประโยชน์มาก และใช้งานได้ดี แต่ฉันต้องการที่จะเลือกไฟล์จากโฟลเดอร์นั้นที่ฉันต้องการให้เรียกใช้แมโครหรือไม่ ไฟล์จะไม่ถูกสร้างโดยอัตโนมัติในโฟลเดอร์ที่แยกจากกัน และฉันต้องเรียกใช้มาโครที่แตกต่างกันในแต่ละชุดของไฟล์จากโฟลเดอร์นั้น จากนั้นจึงย้ายกลับมาในโฟลเดอร์เริ่มต้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันทำตามคำแนะนำแต่ได้รับข้อผิดพลาดในการคอมไพล์ "Loop wihtout Do" ฉันพลาดอะไรไป รหัสมาโครของฉันง่ายมากเพียงแค่เปลี่ยนขนาดตัวอักษรของแถวที่ระบุ ทำงานด้วยตัวมันเอง นี่คือสิ่งที่ฉันมี... โปรดช่วย

Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open (xFdItem & xFileName)
'รหัสของคุณที่นี่
Rows("2:8")).เลือก
ด้วย Selection.Font
.Name = "แอเรียล"
.ขนาด = 12
.Strikethrough = เท็จ
.ตัวยก = เท็จ
.ตัวห้อย = เท็จ
.OutlineFont = เท็จ
.Shadow = เท็จ
.ขีดเส้นใต้ = xlUnderlineStyleNone
.สี = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีค่ะ คุณ yatto
คุณพลาดสคริปต์ "End with" ที่ส่วนท้ายของโค้ด สคริปต์ที่ถูกต้องควรเป็นดังนี้:
Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open (xFdItem & xFileName)
'รหัสของคุณที่นี่
Rows("2:8")).เลือก
ด้วย Selection.Font
.Name = "แอเรียล"
.ขนาด = 16
.Strikethrough = เท็จ
.ตัวยก = เท็จ
.ตัวห้อย = เท็จ
.OutlineFont = เท็จ
.Shadow = เท็จ
.ขีดเส้นใต้ = xlUnderlineStyleNone
.สี = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
จบด้วย
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
End If
ย่อยสิ้นสุด

โปรดลอง หวังว่าจะช่วยคุณได้!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
มาโครที่มีประโยชน์มาก และใช้งานได้ดี แต่ฉันต้องการเลือกไฟล์จากโฟลเดอร์นั้นที่ฉันต้องการให้เรียกใช้แมโครหรือไม่ ตัวอย่างเช่น ฉันมี 4 ไฟล์ในโฟลเดอร์ที่มีไฟล์ excel อื่น ๆ และฉันต้องการให้มันทำงานบน 4 ไฟล์ที่ระบุเท่านั้น ฉันจะปรับแต่งมาโครของคุณเพื่อให้ฉันเลือก 4 ไฟล์เหล่านั้นจากโฟลเดอร์นั้นได้อย่างไร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีโจเอล
ในการเรียกรหัสเดียวกันในสมุดงานเฉพาะ คุณควรใช้รหัสด้านล่าง:

Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
Dim xFB เป็นสตริง
ด้วย Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = จริง
.ฟิลเตอร์.เคลียร์
.ตัวกรองเพิ่ม "excel", "*.xls*"
.แสดง
ถ้า .SelectedItems.Count < 1 แล้วออกจาก Sub
สำหรับ lngCount = 1 ถึง .SelectedItems.Count
xFileName = .SelectedItems(lngCount)
ถ้า xFileName <> "" แล้ว
ด้วย Workbooks.Open(ชื่อไฟล์:=xFileName)
'รหัสของคุณ
จบด้วย
End If
ถัดไป lngCount
จบด้วย
ย่อยสิ้นสุด

โปรดลอง หวังว่าจะช่วยคุณได้!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ขอบคุณครับ มีประโยชน์จริงๆ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hi!

ฉันพยายามแทรกรหัสลงในรหัสของคุณ และเมื่อฉันเรียกใช้แมโคร ข้อความต่อไปนี้แสดงข้อความว่า: ข้อผิดพลาดรันไทม์ '429': ActiveX ไม่สามารถสร้างวัตถุได้ ขอคำแนะนำด้วยว่าจะแก้ไขอย่างไร ขอขอบคุณ!

รหัสของฉัน:

ตั้งค่า RInput = ช่วง ("A2:A21")
ตั้งค่า ROutput = ช่วง ("D2:D22")

Dim A() เป็น Variant
ReDim A(1 ถึง RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripsting.Dictionary")

สำหรับผม = 1 ถึง UBound(A)
ถ้า d.Exists(A(i, 1)) แล้ว
d(A(i, 1)) = d(A(i, 1)) + 1
อื่น
d.เพิ่ม A(i, 1), 1
End If
ต่อไป
สำหรับผม = 1 ถึง UBound(A)
ก(ผม, 1) = ง(ก(ผม, 1))
ต่อไป

ROutput = ก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ก่อนอื่นขอขอบคุณสำหรับมาโครนี้ มันเป็นสิ่งที่ฉันต้องการจริงๆ อย่างไรก็ตาม ฉันมีปัญหาหนึ่งข้อ มีวิธีปิดและบันทึกเมื่อแต่ละหน้าต่างทำงานเสร็จหรือไม่ ฉันมีไฟล์จำนวนมากและ RAM หมดก่อนที่การดำเนินการจะเสร็จสิ้น
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ใช่ เพียงเพิ่มโค้ดต่อไปนี้ด้านล่างหากต้องการบันทึกไฟล์ด้วยชื่อเดียวกัน:

'การบันทึกสมุดงาน
ActiveWorkbook บันทึก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีเคทลิน
บางทีรหัสด้านล่างอาจช่วยคุณได้ ในแต่ละครั้งหลังจากเรียกใช้รหัสเฉพาะของคุณ กล่องข้อความแจ้งบันทึกไฟล์จะปรากฏขึ้นเพื่อเตือนให้คุณบันทึกเวิร์กบุ๊ก

Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
Dim xWB เป็นสมุดงาน
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
เกี่ยวกับข้อผิดพลาดต่อไป
ทำในขณะที่ xFileName <> ""
ตั้งค่า xWB = Workbooks.Open(xFdItem & xFileName)
ด้วย xWB
'รหัสของคุณที่นี่
จบด้วย
xWB.ปิด
xFileName = ผู้อำนวยการ
ห่วง
End If
ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hi!

ฉันพยายามแทรกรหัสลงในรหัสของคุณ และเมื่อฉันเรียกใช้แมโคร ข้อความต่อไปนี้แสดงข้อความว่า: ข้อผิดพลาดรันไทม์ '429': ActiveX ไม่สามารถสร้างวัตถุได้ ขอคำแนะนำด้วยว่าจะแก้ไขอย่างไร ขอขอบคุณ!

รหัสของฉัน:

ตั้งค่า RInput = ช่วง ("A2:A21")
ตั้งค่า ROutput = ช่วง ("D2:D22")

Dim A() เป็น Variant
ReDim A(1 ถึง RInput.Rows.Count, 0)
A = RInput.Value2

Set d = CreateObject("Scripsting.Dictionary")

สำหรับผม = 1 ถึง UBound(A)
ถ้า d.Exists(A(i, 1)) แล้ว
d(A(i, 1)) = d(A(i, 1)) + 1
อื่น
d.เพิ่ม A(i, 1), 1
End If
ต่อไป
สำหรับผม = 1 ถึง UBound(A)
ก(ผม, 1) = ง(ก(ผม, 1))
ต่อไป

ROutput = ก
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี,

ฉันใช้มาโครนี้เพื่อจัดรูปแบบไฟล์ NBA สำเร็จสำหรับ 30 ทีมโดยแต่ละทีมมีหนังสือของตัวเอง เมื่อวานนี้ ฉันได้รับข้อความแสดงข้อผิดพลาดว่า Module (มาโคร) ไม่สามารถทำให้เสร็จหรือถูกลบหรือแก้ไขได้ (จะถูกบันทึกไว้) มันทำให้สมุดงานมาโครส่วนตัวของฉันเสียหาย และทำให้ Excel ไม่สามารถใช้งานได้จริงสำหรับฉัน มันทำให้แอพขัดข้องทุกครั้งที่ฉันพยายามเข้าถึงมาโครจากไฟล์ใด ๆ การสนับสนุน Excel และการสนับสนุน Windows ไม่สามารถแก้ไขสิ่งต่างๆ ได้ คุณช่วยได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี มีวิธีใดบ้างที่ฉันสามารถกำหนดปลายทางของไฟล์ในสคริปต์ได้ ฉันต้องการข้ามขั้นตอนที่ 3 ที่เราต้องเรียกดูโฟลเดอร์เฉพาะ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ขอบคุณสำหรับรหัสนี้ คุณช่วยบอกฉันหน่อยได้ไหมว่าฉันจะมีผลลัพธ์ของมาโครที่ฉันเปิดสมุดงานทั้งหมดในแผ่นเดียว (ผลลัพธ์ของแต่ละสมุดงานในแถว) ได้อย่างไร และมีวิธีเพิ่มชื่อของแต่ละเวิร์กบุ๊กในแถวด้วยข้อมูลจากขั้นตอนก่อนหน้าหรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Hi

ฉันได้รับข้อผิดพลาดรันไทม์ aa 1004: ไวยากรณ์ไม่ถูกต้องเมื่อฉันรันโค้ดต่อไปนี้ซึ่งเป็น Extend Office VBA เพื่อ "เรียกใช้แมโครที่เหมือนกันในหลายเวิร์กบุ๊กที่มีโค้ด VBA" ด้วย Extended Office VBA "ลบช่วงที่มีชื่อทั้งหมด ด้วยรหัส VBA" ในช่องรหัสของคุณ:

Sub LoopThroughFiles ()

Dim xFd เป็น FileDialog

Dim xFdItem เป็นตัวแปร

Dim xFileName เป็นสตริง

ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)

ถ้า xFd.Show = -1 แล้ว

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

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

ทำในขณะที่ xFileName <> ""

ด้วย Workbooks.Open (xFdItem & xFileName)

' ลบย่อยชื่อ()

'อัปเดต 20140314

Dim xName เป็นชื่อ

สำหรับแต่ละ xName ใน Application.ActiveWorkbook.Names

xName.ลบ

ต่อไป


จบด้วย

xFileName = ผู้อำนวยการ

ห่วง

End If

ย่อยสิ้นสุด

สิ่งที่ฉันพยายามทำคือการเรียกใช้แมโครที่ลบช่วงที่มีชื่อในสมุดงานแปดเล่มที่อยู่ในโฟลเดอร์เดียวกัน

BTW นี่เป็นครั้งแรกที่ฉันใช้บางอย่างจาก Extend Office และใช้งานไม่ได้ เว็บไซต์นี้มีประโยชน์กับฉันอย่างมาก

ข้อเสนอแนะ / ความคิดเห็นจะได้รับการชื่นชมอย่างมาก

อัลดีซี
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีครับ คุณ aldc
รหัสของคุณทำงานได้ดีในสมุดงานของฉัน คุณใช้ Excel เวอร์ชันใด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี รหัสนี้ดีมากและมีประโยชน์ ฉันใช้มันมาก!

ทุกวันนี้ ในองค์กรของฉัน เราใช้ SharePoint เพื่อจัดเก็บไฟล์ของเรา มีวิธีใดบ้างที่จะทำให้โค้ดนี้ใช้ได้กับไฟล์ทั้งหมดในโฟลเดอร์แชร์พอยท์หรือไม่?
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ขอบคุณสำหรับรหัสนี้
มีวิธีวนรอบโฟลเดอร์ย่อยด้วยหรือไม่? ให้บอกว่าฉันมีหนึ่งโฟลเดอร์และภายในโฟลเดอร์มีอีกสิบโฟลเดอร์ที่มีไฟล์ excel

มีวิธีเลือกโฟลเดอร์หลักเพื่อให้โค้ดทำงานผ่านโฟลเดอร์ย่อยทั้งหมดหรือไม่

ขอขอบคุณ.
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี Darko หากต้องการเรียกใช้รหัสจากโฟลเดอร์ที่มีโฟลเดอร์ย่อย โปรดใช้รหัสต่อไปนี้: Sub LoopThroughFiles_Subfolders (xStrPath เป็นสตริง)
Dim xSfolderName
Dim xFileName.dm
Dim xArrSFPath() เป็นสตริง
Dim xI เป็นจำนวนเต็ม
ถ้า xStrPath = "" จากนั้นออกจาก Sub
xFileName = Dir(xStrPath & "*.xls*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open(xStrPath & xFileName)
'รหัสของคุณที่นี่
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
xSFolderName = Dir(xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath(0)
ทำในขณะที่ xSFolderName <> ""
ถ้า xSFolderName <> "." และ xSFolderName <> ".." แล้วก็
ถ้า (GetAttr(xStrPath & xSFolderName) และ vbDirectory) = vbDirectory แล้ว
xI = xI + 1
ReDim รักษา xArrSFPath(xI)
xArrSFPath(xI - 1) = xStrPath & xSFolderName & "\"
End If
End If
xSFolderName = ผู้กำกับ
ห่วง
ถ้า UBound(xArrSFPath) > 0 แล้ว
สำหรับ xI = 0 ถึง UBound(xArrSFPath)
LoopThroughFiles_Sub โฟลเดอร์ (xArrSFPath(xI))
ถัดไป xI
End If
ย่อยสิ้นสุด
Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
โฟลเดอร์ LoopThroughFiles_Sub (xFdItem)
End If
End Sub โปรดลอง หวังว่าจะช่วยคุณได้!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นอกจากโค้ดด้านบนแล้ว เป็นไปได้ไหมที่จะเปิดไฟล์ excel ตามลำดับเวลาที่ฉันต้องการ
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดีทุกคน ขอบคุณมากสำหรับมาโครที่ใช้งานได้สะดวกจริงๆ ฉันแค่สงสัยว่าเรามีวิธีรีเฟรชโฟลเดอร์ใน onedrive ผ่านมาโครหรือไม่ ถ้าใช่ โปรดแจ้งให้เราทราบว่าต้องทำอย่างไรเพื่อรีเฟรชไฟล์ใน onedrive โดยใช้สคริปต์มาโคร
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ขอบคุณมากสำหรับสคริปต์นี้ ฉันทำงานได้ดีมากสำหรับฉัน แต่มีความต้องการพิเศษ :มีวิธีเปลี่ยนสคริปต์เพื่อใช้รหัสของฉันกับเงื่อนไขชื่อไฟล์และในโฟลเดอร์ย่อยหรือไม่
ฉันอธิบาย : ฉันเป็นครู และฉันได้สร้างโซลูชัน excel เพื่อบันทึกผลลัพธ์ของนักเรียน และเพื่อให้ครูสามารถปรึกษาพวกเขาได้ ในการทำเช่นนั้น ฉันมีไฟล์ต่อหนึ่งโรงเรียนย่อยและหนึ่งไฟล์สำหรับชั้นเรียนที่รับผิดชอบ ทั้งหมดอยู่ในโฟลเดอร์ต่อชั้นเรียน
ดังนั้นเมื่อฉันพบจุดบกพร่องหรือการเพิ่มประสิทธิภาพ ฉันต้องรายงานการเปลี่ยนแปลงในไฟล์ทั้งหมดในโฟลเดอร์ย่อยทั้งหมด
แต่เนื่องจากไฟล์ทั้งหมดไม่เหมือนกัน (องค์กรย่อยที่แตกต่างกัน) ฉันต้องการวิธีการใช้รหัสที่ตราไว้กับไฟล์ทั้งหมดที่ชื่อ "maths class" ในโฟลเดอร์ย่อยทั้งหมด หรือในทางกลับกัน เพื่อนำรหัสของฉันไปใช้กับไฟล์ทั้งหมด ในโฟลเดอร์ย่อย ยกเว้นไฟล์ทั้งหมดที่ชื่อ "xyz" ขอบคุณ !Fabrice
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
รหัสที่คุณให้ไว้ใช้ไม่ได้กับ VBA ต่อไปนี้ โปรดช่วยSub Bundles()

Dim vWS เป็นเวิร์กชีต
ติ่มซำ vA, vA2()
Dim vR ตราบใด vSum ตราบนาน vC ตราบนาน
Dim vN ตราบใดที่ vN2 ตราบใดที่ vN3 ตราบใดที่

ตั้งค่า vWS = ActiveSheet
ด้วย vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2 (1 ถึง vSum, 1 ถึง 4)
vA = .Range("A2:D" & vR)
สำหรับ vN = 1 ถึง vR - 1
สำหรับ vN2 = 1 ถึง vA(vN, 4)
vC = vC + 1
สำหรับ vN3 = 1 ถึง 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 . ถัดไป
vN2 . ถัดไป
ถัดไป vN
จบด้วย
วีซี = 1
สำหรับ vN = 1 ถึง vSum - 2
vA2(vN, 4) = vC
ถ้า vA2(vN + 1, 2) = vA2(vN, 2) แล้ว
vC = vC + 1
vA2(vN + 1, 4) = vC
อื่น
vA2(vN + 1, 4) = 1
วีซี = 1
End If
ถัดไป vN
Application.ScreenUpdating = เท็จ
แผ่นงานเพิ่ม
ด้วย ActiveSheet
vWS.Range("A1:D1") คัดลอก .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
จบด้วย
Application.ScreenUpdating = จริง

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันต้องการเรียกใช้ VBA นี้ในหลาย ๆ ชีตในโฟลเดอร์พร้อมกันได้โปรดช่วยย่อย Bundles()

Dim vWS เป็นเวิร์กชีต
ติ่มซำ vA, vA2()
Dim vR ตราบใด vSum ตราบนาน vC ตราบนาน
Dim vN ตราบใดที่ vN2 ตราบใดที่ vN3 ตราบใดที่

ตั้งค่า vWS = ActiveSheet
ด้วย vWS
vR = .Cells(Rows.Count, 4).End(xlUp).Row
vSum = Application.Sum(.Range("D2:D" & vR))
ReDim Preserve vA2 (1 ถึง vSum, 1 ถึง 4)
vA = .Range("A2:D" & vR)
สำหรับ vN = 1 ถึง vR - 1
สำหรับ vN2 = 1 ถึง vA(vN, 4)
vC = vC + 1
สำหรับ vN3 = 1 ถึง 4
vA2(vC, vN3) = vA(vN, vN3)
vN3 . ถัดไป
vN2 . ถัดไป
ถัดไป vN
จบด้วย
วีซี = 1
สำหรับ vN = 1 ถึง vSum - 2
vA2(vN, 4) = vC
ถ้า vA2(vN + 1, 2) = vA2(vN, 2) แล้ว
vC = vC + 1
vA2(vN + 1, 4) = vC
อื่น
vA2(vN + 1, 4) = 1
วีซี = 1
End If
ถัดไป vN
Application.ScreenUpdating = เท็จ
แผ่นงานเพิ่ม
ด้วย ActiveSheet
vWS.Range("A1:D1") คัดลอก .Range("A1:D1")
.Cells(2, 1).Resize(vSum, 4) = vA2
จบด้วย
Application.ScreenUpdating = จริง

ย่อยสิ้นสุด
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
ฉันพยายามเรียกใช้โค้ด แต่ข้อผิดพลาด "424 : Object Required" ปรากฏที่บรรทัด "With Workbooks.Open(xFdItem & xFileName)" เมื่อมองลึกลงไป ดูเหมือนว่าเวิร์กบุ๊ก excels ที่จัดเก็บไว้ในโฟลเดอร์ที่สนใจจะไม่แสดง/มีอยู่ (เมื่อหน้าต่างเปิดขึ้นพร้อมกับการแสดงโค้ด หากฉันพยายามเปิดโฟลเดอร์โดยไม่เลือก แสดงว่าว่างเปล่า) ได้อย่างไร?
Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open (xFdItem & xFileName)
แผ่นงาน เพิ่มหลังจาก:=ActiveSheet
ชีต("Sheet2")).Select
ชีต ("Sheet2") .Name = "มาสเตอร์"
ชีต ("มาสเตอร์") เลือก
ชีต("มาสเตอร์") ย้ายก่อนหน้า:=ชีต(1)
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
End If
ย่อยสิ้นสุด


คุณช่วยฉันแก้ปัญหานี้ได้ไหม
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
นี่คือเว็บไซต์โปรดของฉันพร้อมคำแนะนำที่ชัดเจนที่สุด (มากกว่าวิดีโอ YouTube ใด ๆ ) และฉันจะกลับมาดูซ้ำแล้วซ้ำอีก ขอบคุณมากสำหรับบทช่วยสอนเหล่านี้ คุณเป็นผู้ช่วยชีวิตของนักเรียนผู้สำเร็จการศึกษาที่น่าเศร้า
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.xls*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open (xFdItem & xFileName)
' ActiveCell.Offset(0, 1).Columns("A:A")).EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
End If
จบซับ ช่วยทีครับ BTW นามสกุลไฟล์ excel ของฉันคือ (.csv - "comma delimited") และฉันมีไฟล์ excel 500 ไฟล์ในโฟลเดอร์โดยแต่ละแถวมีค่าเฉลี่ยประมาณ 500000 แถว .. โปรดช่วยด้วย ฉันแค่ต้องการแทรกคอลัมน์ในแต่ละสมุดงาน
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
คุณเคยได้รับคำตอบสำหรับคำถามของคุณหรือไม่? ฉันกำลังพยายามทำสิ่งเดียวกันกับไฟล์ csv มากกว่า 3700 ไฟล์ ฉันแค่ต้องเพิ่ม 1 คอลัมน์ (A)
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ผู้ขัดสนและคาร์ลี สำหรับการแก้ปัญหาของคุณ หากต้องการเรียกใช้โค้ดสำหรับไฟล์ CSV หลายไฟล์ คุณเพียงแค่เปลี่ยนนามสกุลไฟล์ .xls เป็น .csv ดังที่แสดงด้านล่าง: Sub LoopThroughFiles ()
Dim xFd เป็น FileDialog
Dim xFdItem เป็นตัวแปร
Dim xFileName เป็นสตริง
ตั้งค่า xFd = Application.FileDialog(msoFileDialogFolderPicker)
ถ้า xFd.Show = -1 แล้ว
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.csv*")
ทำในขณะที่ xFileName <> ""
ด้วย Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset(0, 1).Columns("A:A")).EntireColumn.Select
Selection.Insert Shift:=xlToRight
ActiveCell.Select
จบด้วย
xFileName = ผู้อำนวยการ
ห่วง
End If
End Sub โปรดลอง หวังว่าจะช่วยคุณได้!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี เป็นไปได้ไหมที่จะเรียกใช้มาโครเฉพาะในแผ่นงานของสมุดงานต่างๆ ที่มีชื่อเฉพาะ? ขอบคุณ!!
ความคิดเห็นนี้ถูกย่อให้เล็กสุดโดยผู้ดำเนินรายการบนเว็บไซต์
สวัสดี ซาร่า
ขออภัย ไม่มีวิธีแก้ไขปัญหาที่คุณแจ้งได้ดี
ขอขอบคุณ!
มีความคิดเห็นยังไม่มีการโพสต์ที่นี่
โหลดเพิ่มเติม
แสดงความคิดเห็นของคุณ
โพสต์ในฐานะแขก
×
ให้คะแนนโพสต์นี้:
0   ตัวอักษร
สถานที่แนะนำ