Tách file, Xóa sheet, Đặt pass (1 người xem)

[hungdiep85]

Em chào các Anh Chị:

Em thường làm thủ công bằng cách copy 1 file mới, sau đó xóa sheet A1, A2, A3, còn sheet DULIEU em chỉ xóa số liệu của cột D và cột E, rồi sava lại đặt pass là abc, đặt tên file như file gốc nhưng đằng trước có thêm chữ V.ten file .

Nhưng lúc này nhiều file quá làm thủ công như trên lâu quá trời lâu.
Anh Chị giúp em đọan code với.

Em cảm ơn Anh Chị trước.

 

[nghiaphuc]

Em chào các Anh Chị:

Em thường làm thủ công bằng cách copy 1 file mới, sau đó xóa sheet A1, A2, A3, còn sheet DULIEU em chỉ xóa số liệu của cột D và cột E, rồi sava lại đặt pass là abc, đặt tên file như file gốc nhưng đằng trước có thêm chữ V.ten file .

Nhưng lúc này nhiều file quá làm thủ công như trên lâu quá trời lâu.
Anh Chị giúp em đọan code với.

Em cảm ơn Anh Chị trước.

Code của tôi như sau:
[GPECODE=vb]Sub Test()
Dim i As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False: .EnableEvents = False
End With
With Application.FileDialog(1)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file can thao tac"
.FilterIndex = 3
.AllowMultiSelect = True: .Show
If .SelectedItems.Count = 0 Then Exit Sub
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.Sheets(Array("A1", "A2", "A3")).Delete
.Sheets("DULIEU").[D:E].ClearContents
.SaveAs Filename:=.Path & "\V." & .Name, Password:="abc"
.Close
End With
Next
End With
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .DisplayAlerts = True: .EnableEvents = True
End With
End Sub[/GPECODE]
Bạn tải file đính kèm ở dưới, nhấn nút "Tách file, xóa sheet, đặt pass". Tiếp theo, chọn các file cần thao tác (có thể chọn nhiều file cùng lúc). Code sẽ làm tiếp phần còn lại.
Lưu ý: Code trên chưa bẫy lỗi vấn đề file không đúng cấu trúc, do đó khi chọn các file cần tao tác thì bạn cần đảm bảo rằng các file này đúng cấu trúc như file mẫu. Việc kiểm tra cấu trúc file có lẽ không khó, bạn có thể tham khảo các đoạn code trên diễn đàn về việc kiểm tra sự tồn tại của 1 sheet là viết được code cho việc này.

 

[hungdiep85]

Code của tôi như sau:
[GPECODE=vb]Sub Test()
Dim i As Long
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False: .EnableEvents = False
End With
With Application.FileDialog(1)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file can thao tac"
.FilterIndex = 3
.AllowMultiSelect = True: .Show
If .SelectedItems.Count = 0 Then Exit Sub
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i))
.Sheets(Array("A1", "A2", "A3")).Delete
.Sheets("DULIEU").[D:E].ClearContents
.SaveAs Filename:=.Path & "\V." & .Name, Password:="abc"
.Close
End With
Next
End With
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .DisplayAlerts = True: .EnableEvents = True
End With
End Sub[/GPECODE]
Bạn tải file đính kèm ở dưới, nhấn nút "Tách file, xóa sheet, đặt pass". Tiếp theo, chọn các file cần thao tác (có thể chọn nhiều file cùng lúc). Code sẽ làm tiếp phần còn lại.
Lưu ý: Code trên chưa bẫy lỗi vấn đề file không đúng cấu trúc, do đó khi chọn các file cần tao tác thì bạn cần đảm bảo rằng các file này đúng cấu trúc như file mẫu. Việc kiểm tra cấu trúc file có lẽ không khó, bạn có thể tham khảo các đoạn code trên diễn đàn về việc kiểm tra sự tồn tại của 1 sheet là viết được code cho việc này.

qua tuyện vời Anh Nghĩa Phúc ơi..
Hôm nay em làm bằng file của Anh, em chỉ ngồi đánh pass vô thôi là ok. kaka...
Ah Anh ơi:
Vì file gốc có đặt pass là 123, Anh cho em xin thêm 1 chút code nữa nha hihi..
Khi chọn file xông thì tự nhập pass vô luôn và tất cả các file được chạy code đó sẽ cho vô 1 new folder hết. (toàn bộ file gốc pass điều là 123)

Em cảm ơn anh nhiều lắm.

 

[nghiaphuc]

qua tuyện vời Anh Nghĩa Phúc ơi..
Hôm nay em làm bằng file của Anh, em chỉ ngồi đánh pass vô thôi là ok. kaka...
Ah Anh ơi:
Vì file gốc có đặt pass là 123, Anh cho em xin thêm 1 chút code nữa nha hihi..
Khi chọn file xông thì tự nhập pass vô luôn và tất cả các file được chạy code đó sẽ cho vô 1 new folder hết. (toàn bộ file gốc pass điều là 123)

Em cảm ơn anh nhiều lắm.

Bạn thay code trên bằng code này nhé:
[GPECODE=vb]Sub Test()
Dim i As Long, fPath As String, FS
With Application
.ScreenUpdating = False: .Calculation = xlCalculationManual: .DisplayAlerts = False: .EnableEvents = False
End With
Set FS = CreateObject("Scripting.FileSystemObject")
fPath = ThisWorkbook.Path & "\Result"
With Application.FileDialog(1)
.InitialFileName = ThisWorkbook.Path
.Title = "Chon file can thao tac"
.FilterIndex = 3
.AllowMultiSelect = True: .Show
If .SelectedItems.Count = 0 Then Exit Sub
If Not (FS.FolderExists(fPath)) Then FS.CreateFolder fPath
For i = 1 To .SelectedItems.Count
With Workbooks.Open(.SelectedItems(i), Password:="123")
.Sheets(Array("A1", "A2", "A3")).Delete
.Sheets("DULIEU").Range("D3:E20").ClearContents
.SaveAs Filename:=fPath & "\V." & .Name, Password:="abc"
.Close
End With
Next
End With
With Application
.ScreenUpdating = True: .Calculation = xlCalculationAutomatic: .DisplayAlerts = True: .EnableEvents = True
End With
End Sub[/GPECODE]