Chia tệp Excel

Xin chào,

Tôi đang sử dụng một macro hoạt động rất tốt ngoại trừ một điều. Tôi cần tách bảng tính Excel thành các tệp riêng biệt dựa trên dữ liệu trong một cột. Macro bên dưới thực hiện điều này rất tốt, tuy nhiên, tôi cũng cần mười hàng cuối cùng được đưa vào mỗi tệp mới. Tệp chứa số dư tài khoản yêu cầu một bản xác nhận có dòng chữ ký xuất hiện ở cuối mỗi tệp. Liệu có thể sửa đổi mã để tách tệp dựa trên một cột, bắt đầu từ hàng mong muốn và bao gồm mười hàng cuối cùng của tài liệu trong mỗi tệp không? Tôi rất cảm ơn bất kỳ sự trợ giúp nào bạn có thể cung cấp. Cảm ơn rất nhiều về thời gian và sự giúp đỡ của bạn.

Public Sub SplitToFiles()

' MACRO SplitToFiles

Cập nhật lần cuối: 28/05/2019

Tác giả: mtone

Phiên bản 1.2

' Sự miêu tả:

' Lặp qua một cột được chỉ định và tách từng giá trị riêng biệt thành một tệp riêng bằng cách tạo bản sao và xóa các hàng bên dưới và bên trên cột đó.

'

Lưu ý: Các giá trị trong cột phải là duy nhất hoặc đã được sắp xếp.

'

'Các ô sau đây sẽ bị bỏ qua khi phân định các phần:'

' - ô trống, hoặc chỉ chứa khoảng trắng

' - cùng một giá trị được lặp lại

' - các ô chứa "tổng cộng"

'

Các tệp được lưu trong thư mục con "Split" từ vị trí của sổ làm việc nguồn và được đặt tên theo tên phần.

Bảng tính Dim osh As ' Bảng tính gốc

Dim iRow As Long ' Cursors

Dim iCol As Long

Dim iFirstRow As Long ' Hằng số

Dim iTotalRows Dài ' Không đổi

Dim iStartRow As Long ' Dấu phân cách phần

Dim iStopRow As Long

Dim sSectionName As String ' Tên phần (và tên tệp)

Dim rCell As Range ' current cell

Dim owb As Workbook ' Original workbook

Dim sFilePath As String ' Hằng số

Dim iCount As Integer ' Số lượng tài liệu đã tạo

iCol = Application.InputBox("Nhập số cột dùng để tách", "Chọn cột", 2, , , , , 1)

iRow = Application.InputBox("Nhập số hàng bắt đầu (để bỏ qua tiêu đề)", "Chọn hàng", 2, , , , , 1)

iFirstRow = iRow

Đặt osh = Application.ActiveSheet

Đặt owb = Application.ActiveWorkbook

iTotalRows = osh.UsedRange.Rows.Count

sFilePath = Application.ActiveWorkbook.Path

Nếu Dir(sFilePath + "\Split", vbDirectory) = "" thì

MkDir sFilePath + "\Split"

Kết thúc nếu

'Tắt sự kiện cập nhật màn hình'

Application.EnableEvents = False

Ứng dụng.Màn hình cập nhật = Sai

LÀM

'Lấy ô tại vị trí con trỏ'

Đặt rCell = osh.Cells(iRow, iCol)

sCell = Replace(rCell.Text, " ", ")

Nếu sCell = "" Hoặc (rCell.Text = sSectionName Và iStartRow <> 0) Hoặc InStr(1, rCell.Text, "total", vbTextCompare) <> 0 Thì

' Điều kiện bỏ qua đã được đáp ứng'

Khác

'Đã tìm thấy phần mới'

Nếu iStartRow = 0 thì

'Dấu phân cách StartRow chưa được thiết lập, nghĩa là bắt đầu một phần mới'

sSectionName = rCell.Text

iStartRow = iRow

Khác

'Dấu phân cách StartRow đã được thiết lập, có nghĩa là chúng ta đã đến cuối một phần.'

iStopRow = iRow - 1

'Truyền các biến cho một hàm con riêng biệt để tạo và lưu bảng tính mới.

CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat

iCount = iCount + 1

'Đặt lại dấu phân cách phần

iStartRow = 0

iStopRow = 0

'Sẵn sàng tiếp tục vòng lặp'

iRow = iRow - 1

Kết thúc nếu

Kết thúc nếu

Tiếp tục cho đến khi đạt đến hàng cuối cùng

Nếu iRow < iTotalRows thì

iRow = iRow + 1

Khác

'Hoàn tất. Lưu phần cuối cùng'

iStopRow = iRow

CopySheet osh, iFirstRow, iStartRow, iStopRow, iTotalRows, sFilePath, sSectionName, owb.fileFormat

iCount = iCount + 1

'Lối ra'

Thoát ra

Kết thúc nếu

Vòng lặp

'Bật cập nhật sự kiện màn hình'

Ứng dụng.Màn hình cập nhật = Đúng

Ứng dụng.ChoPhóngSựKiện = Đúng

MsgBox Str(iCount) + " tài liệu đã lưu trong " + sFilePath

End Sub

Public Sub DeleteRows(targetSheet As Worksheet, RowFrom As Long, RowTo As Long)

Dim rngRange As Range

Set rngRange = Range(targetSheet.Cells(RowFrom, 1), targetSheet.Cells(RowTo, 1)).EntireRow

rngRange.Select

rngRange.Delete

End Sub

Public Sub CopySheet(osh As Worksheet, iFirstRow As Long, iStartRow As Long, iStopRow As Long, iTotalRows As Long, sFilePath As String, sSectionName As String, fileFormat As XlFileFormat)

Bảng tính Dim ash ' Bản sao bảng tính

Dim awb As Workbook ' New workbook

Sổ tay

osh.Copy

Đặt ash = Application.ActiveSheet

'Xóa các hàng sau phần

Nếu iTotalRows > iStopRow thì

DeleteRows ash, iStopRow + 1, iTotalRows

Kết thúc nếu

' Xóa các hàng trước phần

Nếu iStartRow > iFirstRow thì

DeleteRows ash, iFirstRow, iStartRow - 1

Kết thúc nếu

Chọn ô trên cùng bên trái

ash.Cells(1, 1).Select

' Loại bỏ một vài ký tự không hợp lệ để tránh tên tệp không hợp lệ'

sSectionName = Replace(sSectionName, "/", " ")

sSectionName = Replace(sSectionName, "\", " ")

sSectionName = Replace(sSectionName, ":", " ")

sSectionName = Replace(sSectionName, "=", " ")

sSectionName = Replace(sSectionName, "*", " ")

sSectionName = Replace(sSectionName, ".", " ")

sSectionName = Replace(sSectionName, "?", " ")

sSectionName = Strings.Trim(sSectionName)

' Lưu ở định dạng giống với bảng tính gốc

ash.SaveAs sFilePath + "\Split\" + sSectionName + " " + "GL"= " " + "MAFES" , fileFormat

' Đóng

Đặt awb = ash.Parent

awb.Close SaveChanges:=False

End Sub

Trả lời:
Chào M
Tôi là V. Arya, Cố vấn độc lập, sẵn sàng hỗ trợ bạn giải quyết vấn đề này.
Yêu cầu duy nhất có phải là chỉ cần bao gồm 10 dòng cuối cùng trong mỗi tệp Excel được tạo ra không? Vui lòng xác nhận.

Trả lời:
Đúng vậy, nhiệm vụ bổ sung duy nhất tôi cần là thêm mười hàng cuối cùng vào mỗi tệp Excel được tạo ra. Cảm ơn rất nhiều về sự giúp đỡ của bạn.

Trả lời:
Tôi cần một tập tin mẫu để xem macro của bạn hoạt động như thế nào. Khi tôi thử nghiệm, nó chỉ tạo ra một tập tin duy nhất. Nếu bạn có thể đăng tải một tập tin mẫu không chứa dữ liệu bí mật lên OneDrive và chia sẻ liên kết ở đây, tôi có thể kiểm tra kỹ hơn.

Trả lời:

Tôi đã tạo một mẫu bảng tính. Cảm ơn bạn đã giúp đỡ.

https://1drv.ms/x/s!Ans2xKtLCG-9b3cmeFwA4_NMryQ?e=enqPf0

Trả lời:
Tôi đã xem qua mã nguồn và tập tin mẫu của bạn.
Tôi cần làm rõ một điều, liệu macro này có hoạt động đúng cách không khi nó cứ tạo ra một tập tin duy nhất và ghi đè lên tập tin hiện có? Đây có phải là cách nó được thiết kế để hoạt động không?

Trả lời:
Hiện tại, macro sẽ tạo một tệp tin với nội dung của ô. Ví dụ, nếu bạn tách theo cột 1, nó sẽ đặt tên tệp tin là A1 cho phần chứa ô A1, và tệp tin tiếp theo sẽ được đặt tên là A2, v.v. Nếu tên tệp tin đã tồn tại trong thư mục, nó sẽ ghi đè lên tệp tin hiện có. Trong quy trình của chúng tôi, sau khi tệp tin được tách ra, các tệp tin riêng lẻ sẽ được di chuyển vào các thư mục riêng biệt, để lại thư mục gốc trống cho lần chạy báo cáo tiếp theo.