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

Làm cách nào để chạy macro cùng lúc trên nhiều tệp sổ làm việc?

Bài viết này, tôi sẽ nói về cách chạy macro trên nhiều tệp sổ làm việc cùng một lúc mà không cần mở chúng. Phương pháp sau đây có thể giúp bạn giải quyết công việc này trong Excel.

Chạy một macro cùng lúc trên nhiều sổ làm việc với mã VBA


Chạy một macro cùng lúc trên nhiều sổ làm việc với mã VBA

Để chạy macro trên nhiều sổ làm việc mà không cần mở chúng, vui lòng áp dụng mã VBA sau:

1. Giữ ALT + F11 phím để mở Microsoft Visual Basic cho các ứng dụng cửa sổ.

2. Nhấp chuột Chèn > Mô-đunvà dán macro sau vào Mô-đun Cửa sổ.

Mã VBA: Chạy cùng một macro trên nhiều sổ làm việc cùng một lúc:

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

Chú thích: Trong mã trên, vui lòng sao chép và dán mã của riêng bạn mà không có Sub tiêu đề và End Sub chân trang giữa Với Workbooks.Open (xFdItem & xFileName) Kết thúc với tập lệnh. Xem ảnh chụp màn hình:

doc chạy macro nhiều tệp 1

3. Sau đó nhấn F5 phím để thực thi mã này và Xem cửa sổ hiển thị, vui lòng chọn một thư mục chứa các sổ làm việc mà bạn muốn áp dụng macro này, xem ảnh chụp màn hình:

doc chạy macro nhiều tệp 2

4. Và sau đó nhấp vào OK , macro mong muốn sẽ được thực thi cùng một lúc từ một sổ làm việc sang các sổ làm việc khác.

 


Các công cụ năng suất văn phòng tốt nhất

Kutools cho Excel giải quyết hầu hết các vấn đề của bạn và tăng 80% năng suất của bạn

  • Tái sử dụng: Chèn nhanh công thức phức tạp, biểu đồ và bất cứ thứ gì bạn đã sử dụng trước đây; Mã hóa ô với mật khẩu; Tạo danh sách gửi thư và gửi email ...
  • Thanh siêu công thức (dễ dàng chỉnh sửa nhiều dòng văn bản và công thức); Bố cục đọc (dễ dàng đọc và chỉnh sửa số lượng ô lớn); Dán vào Dải ô đã Lọchữu ích. Cảm ơn !
  • Hợp nhất các ô / hàng / cột mà không làm mất dữ liệu; Nội dung phân chia ô; Kết hợp các hàng / cột trùng lặp... Ngăn chặn các ô trùng lặp; So sánh các dãyhữu ích. Cảm ơn !
  • Chọn trùng lặp hoặc duy nhất Hàng; Chọn hàng trống (tất cả các ô đều trống); Tìm siêu và Tìm mờ trong Nhiều Sổ làm việc; Chọn ngẫu nhiên ...
  • Bản sao chính xác Nhiều ô mà không thay đổi tham chiếu công thức; Tự động tạo tài liệu tham khảo sang Nhiều Trang tính; Chèn Bullets, Hộp kiểm và hơn thế nữa ...
  • Trích xuất văn bản, Thêm Văn bản, Xóa theo Vị trí, Xóa không gian; Tạo và In Tổng số phân trang; Chuyển đổi giữa nội dung ô và nhận xéthữu ích. Cảm ơn !
  • Siêu lọc (lưu và áp dụng các lược đồ lọc cho các trang tính khác); Sắp xếp nâng cao theo tháng / tuần / ngày, tần suất và hơn thế nữa; Bộ lọc đặc biệt bằng cách in đậm, in nghiêng ...
  • Kết hợp Workbook và WorkSheets; Hợp nhất các bảng dựa trên các cột chính; Chia dữ liệu thành nhiều trang tính; Chuyển đổi hàng loạt xls, xlsx và PDFhữu ích. Cảm ơn !
  • Hơn 300 tính năng mạnh mẽ. Hỗ trợ Office / Excel 2007-2021 và 365. Hỗ trợ tất cả các ngôn ngữ. Dễ dàng triển khai trong doanh nghiệp hoặc tổ chức của bạn. Đầy đủ tính năng Dùng thử miễn phí 30 ngày. Bảo đảm hoàn lại tiền trong 60 ngày.
tab kte 201905

Tab Office mang lại giao diện Tab cho Office và giúp công việc của bạn trở nên dễ dàng hơn nhiều

  • Cho phép chỉnh sửa và đọc theo thẻ trong Word, Excel, PowerPoint, Publisher, Access, Visio và Project.
  • Mở và tạo nhiều tài liệu trong các tab mới của cùng một cửa sổ, thay vì trong các cửa sổ mới.
  • Tăng 50% năng suất của bạn và giảm hàng trăm cú nhấp chuột cho bạn mỗi ngày!
officetab dưới cùng

 

Nhận xét (43)
Xếp hạng 4.5 trong 5 · xếp hạng 1
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Macro rất hữu ích và nó hoạt động tốt, nhưng tôi muốn có thể chọn tệp nào từ thư mục đó mà tôi muốn macro được chạy trên đó? Các tệp không được tạo tự động trong một thư mục riêng biệt và tôi cần chạy các macro khác nhau trên từng nhóm tệp từ thư mục đó, rồi di chuyển chúng trở lại thư mục ban đầu.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đã làm theo hướng dẫn nhưng gặp lỗi biên dịch "Loop wihtout Do". Tôi đang thiếu cái gì? Mã macro của tôi rất đơn giản chỉ cần thay đổi kích thước phông chữ của các hàng được chỉ định. Tự hoạt động. Đây là những gì tôi có ... xin vui lòng giúp đỡ

Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xFdItem & xFileName)
'mã của bạn ở đây
Hàng ("2: 8"). Chọn
Với Selection.Font
.Name = "Arial"
.Size = 12
.Strikethrough = Sai
.Superscript = Sai
.Subscript = Sai
.OutlineFont = Sai
.Shadow = Sai
.Underline = xlUnderlineStyleNone
.Màu = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Kết thúc với
xFileName = Dir
Vòng lặp
Cuối Nếu
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, yarto,
Bạn đã bỏ lỡ tập lệnh "Kết thúc với" ở cuối mã của mình, tập lệnh chính xác phải là sau:
Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xFdItem & xFileName)
'mã của bạn ở đây
Hàng ("2: 8"). Chọn
Với Selection.Font
.Name = "Arial"
.Size = 16
.Strikethrough = Sai
.Superscript = Sai
.Subscript = Sai
.OutlineFont = Sai
.Shadow = Sai
.Underline = xlUnderlineStyleNone
.Màu = -11518420
.TintAndShade = 0
.ThemeFont = xlThemeFontNone
Kết thúc với
Kết thúc với
xFileName = Dir
Vòng lặp
Cuối Nếu
End Sub

Hãy thử nó, hy vọng nó có thể giúp bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Macro rất hữu ích và nó hoạt động tuyệt vời, nhưng tôi muốn có thể chọn tệp nào từ thư mục đó mà tôi muốn macro được chạy trên đó? Ví dụ: tôi có 4 tệp trong một thư mục với các tệp excel khác và tôi chỉ muốn nó chạy trên 4 tệp cụ thể đó. Làm cách nào để điều chỉnh macro của bạn để cho phép tôi chọn 4 tệp đó từ thư mục đó?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Joel,
Để kích hoạt cùng một mã trong các sổ làm việc cụ thể, bạn nên áp dụng mã dưới đây:

Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Làm mờ xFB dưới dạng chuỗi
Với Application.FileDialog (msoFileDialogOpen)
.AllowMultiSelect = True
.Filters.Clear
.Filters. Thêm "excel", "* .xls *"
.Chỉ
If .SelectedItems.Count <1 Then Exit Sub
Đối với lngCount = 1 Tới .SelectedItems.Count
xFileName = .SelectedItems (lngCount)
Nếu xFileName <> "" Thì
Với Workbooks.Open (Tên tệp: = xFileName)
'ma cua ban
Kết thúc với
Cuối Nếu
LngCount tiếp theo
Kết thúc với
End Sub

Hãy thử nó, hy vọng nó có thể giúp bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
cảm ơn, rất hữu ích
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi!

Tôi cố gắng chèn mã của mình vào mã của bạn và khi tôi chạy macro, nó cho tôi thông báo sau: Lỗi thời gian chạy '429': ActiveX không thể tạo đối tượng. Xin vui lòng cho biết làm thế nào nó có thể được sửa chữa. Cảm ơn bạn!

Mã của tôi:

Đặt RInput = Range ("A2: A21")
Đặt ROutput = Phạm vi ("D2: D22")

Dim A () As Variant
ReDim A (1 Đến RInput.Rows.Count, 0)
A = RInput.Value2

Đặt d = CreateObject ("Scripsting.Dictionary")

Đối với i = 1 Đến UBound (A)
Nếu d.Exists (A (i, 1)) Thì
d (A (i, 1)) = d (A (i, 1)) + 1
Khác
d. Thêm A (i, 1), 1
Cuối Nếu
Sau
Đối với i = 1 Đến UBound (A)
A (i, 1) = d (A (i, 1))
Sau

Đầu ra = A
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, đầu tiên cảm ơn bạn vì macro này, nó chính xác là thứ tôi đang tìm kiếm. Tuy nhiên, tôi có một vấn đề, có cách nào để đóng và lưu khi mỗi cửa sổ hoàn thành không. Tôi có một lượng lớn tệp và sắp hết RAM trước khi quá trình thực thi hoàn tất.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Có, Chỉ cần thêm vào bên dưới mã sau của bạn nếu bạn muốn nó lưu tệp có cùng tên:

'Lưu Sổ làm việc
ActiveWorkbook.Save
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Caitlin,
Có thể đoạn mã dưới đây có thể giúp bạn, mỗi lần sau khi chạy mã cụ thể của bạn, một hộp nhắc lưu tệp sẽ bật ra nhắc bạn lưu sổ làm việc.

Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Làm mờ xWB dưới dạng sổ làm việc
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
On Error Resume Next
Làm trong khi xFileName <> ""
Đặt xWB = Workbooks.Open (xFdItem & xFileName)
Với xWB
'mã của bạn ở đây
Kết thúc với
xWB.C Close
xFileName = Dir
Vòng lặp
Cuối Nếu
End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi!

Tôi cố gắng chèn mã của mình vào mã của bạn và khi tôi chạy macro, nó cho tôi thông báo sau: Lỗi thời gian chạy '429': ActiveX không thể tạo đối tượng. Xin vui lòng cho biết làm thế nào nó có thể được sửa chữa. Cảm ơn bạn!

Mã của tôi:

Đặt RInput = Range ("A2: A21")
Đặt ROutput = Phạm vi ("D2: D22")

Dim A () As Variant
ReDim A (1 Đến RInput.Rows.Count, 0)
A = RInput.Value2

Đặt d = CreateObject ("Scripsting.Dictionary")

Đối với i = 1 Đến UBound (A)
Nếu d.Exists (A (i, 1)) Thì
d (A (i, 1)) = d (A (i, 1)) + 1
Khác
d. Thêm A (i, 1), 1
Cuối Nếu
Sau
Đối với i = 1 Đến UBound (A)
A (i, 1) = d (A (i, 1))
Sau

Đầu ra = A
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào bạn,

Tôi đã sử dụng thành công macro này để định dạng các tệp NBA cho 30 đội, mỗi đội có một cuốn sách riêng. Hôm qua, tôi nhận được thông báo lỗi và không thể hoàn thành Mô-đun (macro) hoặc xóa hoặc chỉnh sửa (để lưu). Nó đã làm hỏng sổ làm việc macro cá nhân của tôi và khiến tôi hầu như không sử dụng được Excel. Nó làm ứng dụng bị treo mỗi khi tôi cố gắng truy cập macro từ bất kỳ tệp nào. Hỗ trợ Excel và hỗ trợ Windows không có khả năng khắc phục sự cố. Bạn có thể giúp?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Có cách nào để tôi có thể xác định đích tệp trong chính tập lệnh không. Tôi muốn bỏ qua quá trình 3, nơi chúng ta phải duyệt qua thư mục cụ thể.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn vì mã này. bạn có thể vui lòng cho tôi biết làm thế nào tôi có thể có kết quả của macro của tôi mà tôi đã mở tất cả các sổ làm việc trong một trang tính (kết quả của mỗi sổ làm việc trong một hàng)? và có cách nào để thêm tên của mỗi sổ làm việc vào hàng có dữ liệu từ bước trước không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Hi

Tôi gặp lỗi aa 1004 run-time: cú pháp không chính xác khi tôi chạy mã sau đây là Mở rộng Office VBA để "Chạy macro cùng lúc trên nhiều sổ làm việc có mã VBA" với Mở rộng Office VBA "Xóa tất cả các phạm vi được đặt tên với mã VBA "trong vùng chèn mã của bạn:

Sub LoopThroughFiles ()

Làm mờ xFd dưới dạng FileDialog

Dim xFdItem dưới dạng biến thể

Dim xFileName dưới dạng chuỗi

Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)

Nếu xFd.Show = -1 Thì

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

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

Làm trong khi xFileName <> ""

Với Workbooks.Open (xFdItem & xFileName)

'Sub DeleteNames ()

'Cập nhật 20140314

Dim xName As Name

Đối với mỗi xName trong ứng dụng.ActiveWorkbook.Names

xName.Delete

Sau


Kết thúc với

xFileName = Dir

Vòng lặp

Cuối Nếu

End Sub

Những gì tôi đang cố gắng làm là chạy macro xóa các phạm vi được đặt tên trong tám sổ làm việc được chứa trong cùng một thư mục.

BTW, đây là lần đầu tiên tôi sử dụng thứ gì đó từ Extend Office và nó không hoạt động. Trang web này rất hữu ích đối với tôi.

Các đề xuất / bình luận sẽ được đánh giá rất cao.

aldc
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, aldc,
Mã của bạn hoạt động tốt trong sổ làm việc của tôi, bạn sử dụng phiên bản Excel nào?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, mã này rất hay và hữu ích. Tôi sử dụng nó rất nhiều!

Ngày nay, trong tổ chức của tôi, chúng tôi sử dụng SharePoint để lưu trữ các tệp của mình. Có cách nào để làm cho mã này hoạt động trên tất cả các tệp trong thư mục điểm chia sẻ không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn vì mã này.
Có cách nào để lặp qua các thư mục con không? Giả sử tôi có một thư mục và trong thư mục có thêm mười thư mục, mỗi thư mục chứa một tệp excel.

Có cách nào để chỉ chọn thư mục chính để mã chạy qua tất cả các thư mục con của nó không?

Cảm ơn bạn.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Darko, Để chạy mã từ một thư mục có các thư mục con, vui lòng áp dụng mã sau: Sub LoopThroughFiles_Subfolders (xStrPath As String)
Dim xSFolderName
Dim xFileName
Dim xArrSFPath () Dưới dạng chuỗi
Dim xI dưới dạng số nguyên
If xStrPath = "" Then Exit Sub
xFileName = Dir (xStrPath & "* .xls *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xStrPath & xFileName)
'mã của bạn ở đây
Kết thúc với
xFileName = Dir
Vòng lặp
xSFolderName = Dir (xStrPath, vbDirectory)
xI = 0
ReDim xArrSFPath (0)
Thực hiện trong khi xSFolderName <> ""
Nếu xSFolderName <> "." Và xSFolderName <> ".." Sau đó
If (GetAttr (xStrPath & xSFolderName) And vbDirectory) = vbDirectory Sau đó
xI = xI + 1
ReDim Bảo tồn xArrSFPath (xI)
xArrSFPath (xI - 1) = xStrPath & xSFolderName & "\"
Cuối Nếu
Cuối Nếu
xSFolderName = Dir
Vòng lặp
Nếu UBound (xArrSFPath)> 0 Thì
Đối với xI = 0 Đến UBound (xArrSFPath)
LoopThroughFiles_Subfolders (xArrSFPath (xI))
XI tiếp theo
Cuối Nếu
End Sub
Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
LoopThroughFiles_Subfolders (xFdItem)
Cuối Nếu
End SubXin vui lòng cố gắng, hy vọng nó có thể giúp bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Ngoài đoạn mã trên, có thể mở tệp excel theo thứ tự thời gian mà tôi muốn không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn rất nhiều vì macro nó thực sự tiện dụng để làm việc với. Tôi chỉ tự hỏi liệu chúng ta có cách nào để làm mới thư mục trong onedrive thông qua macro hay không. Nếu có, bạn có thể vui lòng cho tôi biết tôi có thể làm gì ở đây để làm mới các tệp trong onedrive bằng cách sử dụng tập lệnh macro không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, cảm ơn rất nhiều vì tập lệnh này, tôi làm việc rất tốt cho tôi, nhưng tôi có nhu cầu đặc biệt: Có cách nào để thay đổi tập lệnh để áp dụng mã của tôi với điều kiện tên tệp VÀ trong thư mục con không?
Tôi giải thích: Tôi là một giáo viên và tôi đã tạo một giải pháp excel để lưu kết quả của học sinh và cho phép giáo viên tham khảo ý kiến ​​của họ.
Vì vậy, khi tôi tìm thấy một lỗi hoặc một tối ưu hóa, tôi phải báo cáo những thay đổi trong tất cả các tệp trong tất cả các thư mục con.
Nhưng vì tất cả các tệp đều không giống nhau (tổ chức các tệp con khác nhau), tôi muốn có một cách để áp dụng mã code par exemple của mình cho tất cả các tệp có tên "lớp maths" trong tất cả các thư mục con, hoặc ngược lại, để áp dụng mã của tôi cho tất cả các tệp trong các thư mục con ngoại trừ tất cả các tệp có tên "xyz". Cảm ơn! Fabrice
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Mã đã cho của bạn không hoạt động với VBA sau đây, bạn có thể vui lòng trợ giúpSub Bundles ()

Làm mờ vWS dưới dạng trang tính
Làm mờ vA, vA2 ()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Đặt vWS = ActiveSheet
Với vWS
vR = .Cells (Rows.Count, 4) .End (xlUp) .Row
vSum = Application.Sum (.Range ("D2: D" & vR))
ReDim Bảo tồn vA2 (1 đến vSum, 1 đến 4)
vA = .Range ("A2: D" & vR)
Đối với vN = 1 Đến vR - 1
Đối với vN2 = 1 Đến vA (vN, 4)
vC = vC + 1
Đối với vN3 = 1 đến 4
vA2 (vC, vN3) = vA (vN, vN3)
VN3 tiếp theo
VN2 tiếp theo
VN tiếp theo
Kết thúc với
vC = 1
Đối với vN = 1 Đến vSum - 2
vA2 (vN, 4) = vC
Nếu vA2 (vN + 1, 2) = vA2 (vN, 2) Thì
vC = vC + 1
vA2 (vN + 1, 4) = vC
Khác
vA2 (vN + 1, 4) = 1
vC = 1
Cuối Nếu
VN tiếp theo
Application.ScreenUpdating = Sai
Trang tính.Thêm
Với ActiveSheet
vWS.Range ("A1: D1"). Sao chép .Range ("A1: D1")
.Cells (2, 1) .Resize (vSum, 4) = vA2
Kết thúc với
Application.ScreenUpdating = True

End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi muốn chạy VBA này vào nhiều Trang tính trong một thư mục cùng một lúc, bạn có thể giúp đỡ không

Làm mờ vWS dưới dạng trang tính
Làm mờ vA, vA2 ()
Dim vR As Long, vSum As Long, vC As Long
Dim vN As Long, vN2 As Long, vN3 As Long

Đặt vWS = ActiveSheet
Với vWS
vR = .Cells (Rows.Count, 4) .End (xlUp) .Row
vSum = Application.Sum (.Range ("D2: D" & vR))
ReDim Bảo tồn vA2 (1 đến vSum, 1 đến 4)
vA = .Range ("A2: D" & vR)
Đối với vN = 1 Đến vR - 1
Đối với vN2 = 1 Đến vA (vN, 4)
vC = vC + 1
Đối với vN3 = 1 đến 4
vA2 (vC, vN3) = vA (vN, vN3)
VN3 tiếp theo
VN2 tiếp theo
VN tiếp theo
Kết thúc với
vC = 1
Đối với vN = 1 Đến vSum - 2
vA2 (vN, 4) = vC
Nếu vA2 (vN + 1, 2) = vA2 (vN, 2) Thì
vC = vC + 1
vA2 (vN + 1, 4) = vC
Khác
vA2 (vN + 1, 4) = 1
vC = 1
Cuối Nếu
VN tiếp theo
Application.ScreenUpdating = Sai
Trang tính.Thêm
Với ActiveSheet
vWS.Range ("A1: D1"). Sao chép .Range ("A1: D1")
.Cells (2, 1) .Resize (vSum, 4) = vA2
Kết thúc với
Application.ScreenUpdating = True

End Sub
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Tôi đã cố gắng chạy mã nhưng lỗi "424: Đối tượng Bắt buộc" xuất hiện ở dòng "Với Workbooks.Open (xFdItem & xFileName)". Bằng cách nhìn sâu hơn, có vẻ như các sổ làm việc vượt trội được lưu trữ trong thư mục quan tâm không hiển thị / tồn tại (Khi cửa sổ mở ra với màn hình mã, nếu tôi cố gắng mở thư mục và không chọn nó, thì nó trống). Làm thế nào như vậy?
Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xFdItem & xFileName)
Sheets.Add After: = ActiveSheet
Trang tính ("Trang tính2"). Chọn
Trang tính ("Trang tính 2"). Name = "Trang chủ"
Trang tính ("Chính"). Chọn
Trang tính ("Chính"). Di chuyển trước: = Trang tính (1)
Kết thúc với
xFileName = Dir
Vòng lặp
Cuối Nếu
End Sub


Bạn có thể vui lòng giúp tôi giải quyết vấn đề này không?
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Đây là trang web yêu thích của tôi với các hướng dẫn rõ ràng tuyệt đối (nhiều hơn bất kỳ video nào trên YouTube) và tôi tiếp tục quay lại nó nhiều lần. Cảm ơn bạn rất nhiều về những hướng dẫn này - bạn là một cứu cánh cho một học sinh tốt nghiệp.
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .xls *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xFdItem & xFileName)
'ActiveCell.Offset (0, 1) .Columns ("A: A"). EntireColumn.Select
Selection.Insert Shift: = xlToRight
ActiveCell.Select
Kết thúc với
xFileName = Dir
Vòng lặp
Cuối Nếu
Kết thúc Sub, xin vui lòng giúp đỡ. BTW, phần mở rộng tệp excel của tôi là (.csv - "được phân cách bằng dấu phẩy"). và tôi có 500 tệp excel trong một thư mục với mỗi hàng trung bình khoảng 500000 số hàng .. Vui lòng giúp đỡ. Tôi chỉ muốn chèn columnin vào mỗi sổ làm việc
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Bạn đã bao giờ nhận được câu trả lời cho câu hỏi của mình chưa? Tôi đang cố gắng làm điều tương tự với hơn 3700 tệp csv. Tôi chỉ cần thêm 1 cột (A).
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, Needy và Carly, Để giải quyết vấn đề của bạn, để chạy mã cho nhiều tệp CSV, bạn chỉ cần thay đổi phần mở rộng tệp .xls thành .csv như mã bên dưới được hiển thị: Sub LoopThroughFiles ()
Làm mờ xFd dưới dạng FileDialog
Dim xFdItem dưới dạng biến thể
Dim xFileName dưới dạng chuỗi
Đặt xFd = Application.FileDialog (msoFileDialogFolderPicker)
Nếu xFd.Show = -1 Thì
xFdItem = xFd.SelectedItems (1) & Application.PathSeparator
xFileName = Dir (xFdItem & "* .csv *")
Làm trong khi xFileName <> ""
Với Workbooks.Open (xFdItem & xFileName)
ActiveCell.Offset (0, 1) .Columns ("A: A"). EntireColumn.Select
Selection.Insert Shift: = xlToRight
ActiveCell.Select
Kết thúc với
xFileName = Dir
Vòng lặp
Cuối Nếu
End SubXin vui lòng cố gắng, hy vọng nó có thể giúp bạn!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Xin chào, có thể chỉ chạy macro trong các trang tính của các sổ làm việc khác nhau với một tên cụ thể không? Cảm ơn!!
Nhận xét này đã được giảm thiểu bởi người điều hành trên trang web
Chào, Sara,
Xin lỗi, không có giải pháp tốt cho vấn đề bạn nêu ra.
Cảm ơn bạn!
Không có bình luận nào được đăng ở đây
Tải thêm
Để lại ý kiến ​​của bạn
Đăng với tư cách khách
×
Đánh giá bài viết này:
0   Nhân vật
Các vị trí được đề xuất

Kết nối với chúng tôi

Bản quyền © 2009 - www.extendoffice.com. | Đã đăng ký Bản quyền. cung cấp bởi ExtendOffice. | BẢN ĐỒ CHI NHÁNH
Microsoft và logo Office là các nhãn hiệu hoặc nhãn hiệu đã đăng ký của Microsoft Corporation tại Hoa Kỳ và / hoặc các quốc gia khác.
Được bảo vệ bởi Sectigo SSL