Xóa dòng các file trong thư mục (4 người xem)

hongphuong1997 · 8/4/23

Trong thư mục có nhiều file
Trong các file có nhiều Sheets
Và trong mỗi file có Sheet("Nguon")
Em muốn Delete dòng 5:8 của Sheet("Nguon") của tất cả các file có Sheet("Nguon")
Nếu file nào không có Sheet("Nguon") thì bỏ qua
Cháu nhờ các bác và anh chị viết giúp code này với ạ
Cháu cảm hơn các bác và anh chị ạ!

ptm0412 · 8/4/23

Viết 1 hàm kiểm tra sự tồn tại của sheet

Mã:

Function ShExist(ByVal Wb As Workbook, ByVal ShName As String) As Boolean
ShExist = False
For Each Sh In Wb.Sheets
    If Sh.Name = ShName Then ShExist = True: Exit For
Next
End Function

Sau đó viết code mở lần lượt từng file trong folder, trong đó có đoạn:

Mã:

Workbook.Open blabla
 If ShExist(ActiveWorkbook, "Nguon") = True Then
    Sheets("Nguon").Rows("5:8").EntireRow.Delete
End If
ActiveWorkbook.Close True

hongphuong1997 · 8/4/23

ptm0412 đã viết:
Viết 1 hàm kiểm tra sự tồn tại của sheet

Mã:

Function ShExist(ByVal Wb As Workbook, ByVal ShName As String) As Boolean ShExist = False For Each Sh In Wb.Sheets If Sh.Name = ShName Then ShExist = True: Exit For Next End Function

Sau đó viết code mở lần lượt từng file trong folder, trong đó có đoạn:

Mã:

Workbook.Open blabla If ShExist(ActiveWorkbook, "Nguon") = True Then Sheets("Nguon").Rows("5:8").EntireRow.Delete End If ActiveWorkbook.Close True

Cháu cảm ơn bác ạ
Bác viết cho cháu với bác, cháu chưa biết viết như nào bác oi

ptm0412 · 8/4/23

hongphuong1997 đã viết:
Cháu cảm ơn bác ạ
Bác viết cho cháu với bác, cháu chưa biết viết như nào bác oi

Cái chỗ Workbook.Open trên diễn đàn có nhiều rồi

hongphuong1997 · 8/4/23

ptm0412 đã viết:
Cái chỗ Workbook.Open trên diễn đàn có nhiều rồi

huhu..... cháu cứ học mãi mà nó cứ như nước đổ đầu vịt ấy bác oi
Mấy năm trời nghiên cứu mà không biết làm gì bác oi
Bác ngoáy cho cháu xin đi bác

hoanganhvo2612 · 8/4/23

cái này cần phải để ý vấn đề là 1 số file xoá xong rồi bị lỗi ở file sau, nếu chạy lại thì lại xoá tiếp thì có vấn đề gì không?

hongphuong1997 · 8/4/23

hoanganhvo2612 đã viết:
cái này cần phải để ý vấn đề là 1 số file xoá xong rồi bị lỗi ở file sau, nếu chạy lại thì lại xoá tiếp thì có vấn đề gì không?

Không vấn đề gì ạ

Thóc Sama · 8/4/23

hongphuong1997 đã viết:
Cháu cảm ơn bác ạ
Bác viết cho cháu với bác, cháu chưa biết viết như nào bác oi

Nay thầy đang bận tài liệu mai thuyết trình.
Giờ tớ coi bóng đá, mai tớ “cốt” thử xem được không nhá!

hongphuong1997 · 8/4/23

THÓC SAMA đã viết:
Nay thầy đang bận tài liệu mai thuyết trình.
Giờ tớ coi bóng đá, mai tớ “cốt” thử xem được không nhá!

hihi..... khiếp, đối với em thì rất khó, nhưng đối với các anh thì viết chớp mắt một cái là

xong ngay mừ

Hoàng Tuấn 868 · 8/4/23

hongphuong1997 đã viết:
chớp mắt một cái

Thử file này trong lúc đợi nhé.

hongphuong1997 · 8/4/23

Hoàng Tuấn 868 đã viết:
Thử file này trong lúc đợi nhé.

Em cảm ơn anh rất nhiều ạ
Quá chuẩn rùi anh oi
Nhưng có nhược điểm là phải chọn thư mục và chọn file
Em muốn như này anh nhé
Em muốn xóa các file ở thư mục nào thì cho file (Xóa của anh vào thư mục đó)
Mà bỏ đi khâu chọn thư mục và chọn các file
Anh viết cho em theo phương pháp đó với anh.

Hoàng Nhật Phương · 8/4/23

Góp vui . . .

Mã:

Option Explicit

Sub deleteRows()

    Dim fso As Object, folder As Object, file As Object
    Dim wb As Workbook, ws As Worksheet
    Dim folderPath As String

    folderPath = "C:\Users\OT\Desktop\Folder\" 'Duong dan thu muc chua file excel
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath) '
    
    For Each file In folder.Files
        If LCase(file.Name) Like "*.xls*" Then
            Set wb = Workbooks.Open(file.Path)
            On Error Resume Next
            Set ws = wb.Worksheets("Nguon")
            On Error GoTo 0
            If Not ws Is Nothing Then
                Application.DisplayAlerts = False
                ws.Rows("5:8").Delete Shift:=xlUp
                Application.DisplayAlerts = True
                wb.Save
            End If
            wb.Close False
        End If
    Next file
    
    MsgBox "Hoàn thành!"
    
End Sub

Hoàng Tuấn 868 · 8/4/23

hongphuong1997 đã viết:
Em cảm ơn anh rất nhiều ạ
Quá chuẩn rùi anh oi
Nhưng có nhược điểm là phải chọn thư mục và chọn file
Em muốn như này anh nhé
Em muốn xóa các file ở thư mục nào thì cho file (Xóa của anh vào thư mục đó)
Mà bỏ đi khâu chọn thư mục và chọn các file
Anh viết cho em theo phương pháp đó với anh.

Bài #12 đáp ứng tiêu chí bài #11 rồi nhé.

hongphuong1997 đã viết:
Mà bỏ đi khâu chọn thư mục và chọn các file

Vụ này nhiều trường hợp lưu nhầm vào folder và bị xóa tuốt rồi, nên chọn trước khi xóa cho cẩn thận.

VetMini · 9/4/23

hoanganhvo2612 đã viết:
cái này cần phải để ý vấn đề là 1 số file xoá xong rồi bị lỗi ở file sau, nếu chạy lại thì lại xoá tiếp thì có vấn đề gì không?

Trước khi mở file, copy nó lại thành <Filename>GPE_Saved.xlsx.
Lỡ bị gì thì từ đó moi ra.

Hoàng Nhật Phương đã viết:
Góp vui . . .

Sub deleteRows()
' cần thay đổi tham số thì thay ở đây.
MsgBox FdeleteRows( "C:\Users\OT\Desktop\Folder\", "Nguon", "5:8" ) & " File(s) Amended"
End Sub

Function FdeleteRows(folderPath As String, shName As String, rowNums As String) As Long

Dim fso As Object, folder As Object, file As Object
Dim wb As Workbook, ws As Worksheet
Dim folderPath As String

' folderPath = "C:\Users\OT\Desktop\Folder\" 'Duong dan thu muc chua file excel
Set fso = CreateObject("Scripting.FileSystemObject")
Set folder = fso.GetFolder(folderPath) '

For Each file In folder.Files
If LCase(file.Name) Like "*.xls*" Then
Set wb = Workbooks.Open(file.Path)
On Error Resume Next
Set ws = wb.Worksheets(shName)
On Error GoTo 0
If Not ws Is Nothing Then
Application.DisplayAlerts = False
ws.Rows(rowNums).Delete Shift:=xlUp
Application.DisplayAlerts = True
wb.Save
FdeleteRows = FdeleteRows + 1
End If
wb.Close False
End If
Next file

' MsgBox "Hoàn thành!"

End Sub

Thóc Sama · 9/4/23

hongphuong1997 đã viết:
hihi..... khiếp, đối với em thì rất khó, nhưng đối với các anh thì viết chớp mắt một cái là View attachment 288684xong ngay mừ

Thấy con Gấu khóc nhiều quá tớ cũng thử làm.
Chạy Code dưới xem được không nhá!
Chú ý là tên file trong Folder phải bằng tiếng Anh/tiếng Việt không dấu nha!

Mã:

Sub Xoa_Lung_Tung()
    Dim MyFolder$, Wb As Workbook, Ws As Worksheet
    Dim MyFile$, MainWB As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
    MyFolder = ThisWorkbook.Path 'Lay duong link toi thu muc chua file
    Set MainWB = ThisWorkbook
    MyFile = Dir(MyFolder & "\*.xls*")
    '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
    Do While MyFile <> "" 'Loop qua cac file coa trong thu muc
        If MyFile <> MainWB.Name Then 'Neu ten file khac voi file hien hanh thi Run Code
            Workbooks.Open FileName:=MyFolder & "\" & MyFile 'Mo File len
            Set Wb = ActiveWorkbook 'Lam viec voi File moi mo
            With Wb
                For Each Ws In .Worksheets 'Lap qua cac sheet
                    If Ws.Name = "Nguon" Then Rows("5:8").Delete 'neu la sheet nguon thi xoa dong 5-->8
                Next
            End With
            Wb.Close True 'Dong va luu file
        End If
        MyFile = Dir
    Loop
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Hoàng Tuấn 868 · 9/4/23

THÓC SAMA đã viết:
Chú ý là tên file trong Folder phải bằng tiếng Anh/tiếng Việt không dấu nha!

Sao bài của tớ tên tập tin bằng tiếng gì nó cũng nhai hết nhỉ.

Thóc Sama · 9/4/23

Hoàng Tuấn 868 đã viết:
Sao bài của tớ tên tập tin bằng tiếng gì nó cũng nhai hết nhỉ.

Code bác "ăn tạp" quá chăng?
Do bác viết theo cách chọn folder, và chỉ định files
Của tôi thì nó lấy tất các files trong folder chứa file Main.
Ù, vậy có lẽ Code tôi mới được gọi là "tạp ăn" mới đúng chứ nhỉ?

Hoàng Tuấn 868 · 9/4/23

THÓC SAMA đã viết:
Code bác "ăn tạp" quá chăng?
Do bác viết theo cách chọn folder, và chỉ định files
Của tôi thì nó lấy tất các files trong folder chứa file Main.
Ù, vậy có lẽ Code tôi mới được gọi là "tạp ăn" mới đúng chứ nhỉ?

Bạn thử chỉ lấy theo thứ tự file thôi, còn tên file là gì không quan tâm có lẽ sẽ nhai được hết mà không phải đi sửa lại tên file nữa.

Thóc Sama · 9/4/23

Hoàng Tuấn 868 đã viết:
Bạn thử chỉ lấy theo thứ tự file thôi, còn tên file là gì không quan tâm có lẽ sẽ nhai được hết mà không phải đi sửa lại tên file nữa.

Cám ơn bác, để xem thớt có yêu cầu không để tùy biến sau.

hongphuong1997 · 9/4/23

Hoàng Nhật Phương đã viết:

Góp vui . . .

Mã:

Option Explicit

Sub deleteRows()

    Dim fso As Object, folder As Object, file As Object
    Dim wb As Workbook, ws As Worksheet
    Dim folderPath As String

    folderPath = "C:\Users\OT\Desktop\Folder\" 'Duong dan thu muc chua file excel
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set folder = fso.GetFolder(folderPath) '
   
    For Each file In folder.Files
        If LCase(file.Name) Like "*.xls*" Then
            Set wb = Workbooks.Open(file.Path)
            On Error Resume Next
            Set ws = wb.Worksheets("Nguon")
            On Error GoTo 0
            If Not ws Is Nothing Then
                Application.DisplayAlerts = False
                ws.Rows("5:8").Delete Shift:=xlUp
                Application.DisplayAlerts = True
                wb.Save
            End If
            wb.Close False
        End If
    Next file
   
    MsgBox "Hoàn thành!"
   
End Sub

Em cảm ơn chị @Hoàng Nhật Phương ạ code chạy rất chuẩn chị oi
Nhưng bây giờ em muốn chọn nhiều thư mục một lần thì thêm như nào hở chị?

Bài đã được tự động gộp: 9/4/23

THÓC SAMA đã viết:

Thấy con Gấu khóc nhiều quá tớ cũng thử làm.
Chạy Code dưới xem được không nhá!
Chú ý là tên file trong Folder phải bằng tiếng Anh/tiếng Việt không dấu nha!

Mã:

Sub Xoa_Lung_Tung()
    Dim MyFolder$, Wb As Workbook, Ws As Worksheet
    Dim MyFile$, MainWB As Workbook
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
    MyFolder = ThisWorkbook.Path 'Lay duong link toi thu muc chua file
    Set MainWB = ThisWorkbook
    MyFile = Dir(MyFolder & "\*.xls*")
    '_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/
    Do While MyFile <> "" 'Loop qua cac file coa trong thu muc
        If MyFile <> MainWB.Name Then 'Neu ten file khac voi file hien hanh thi Run Code
            Workbooks.Open FileName:=MyFolder & "\" & MyFile 'Mo File len
            Set Wb = ActiveWorkbook 'Lam viec voi File moi mo
            With Wb
                For Each Ws In .Worksheets 'Lap qua cac sheet
                    If Ws.Name = "Nguon" Then Rows("5:8").Delete 'neu la sheet nguon thi xoa dong 5-->8
                Next
            End With
            Wb.Close True 'Dong va luu file
        End If
        MyFile = Dir
    Loop
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub

Em cảm ơn anh @THÓC SAMA code đúng theo ý tưởng của em là cho vào thư mục cần xóa để đỡ nhầm lẫn anh ah
Anh chỉnh cho em là code đọc được cả file tiếng việt như anh @Hoàng Tuấn 868 góp ý với anh nhé
Em cảm ơn anh.

Xóa dòng các file trong thư mục (4 người xem)

Người dùng đang xem chủ đề này

Thành viên tiêu biểu

File đính kèm

Bad Excel Member

Thành viên tiêu biểu

Bad Excel Member

Thành viên tiêu biểu

Thành viên thường trực

Thành viên tiêu biểu

＿/＿/＿/＿/＿/＿/＿/

Thành viên tiêu biểu

Đăng ký hôm qua

File đính kèm

Thành viên tiêu biểu

Thành viên gắn bó

Đăng ký hôm qua

Ăn cùng góc phố

＿/＿/＿/＿/＿/＿/＿/

File đính kèm

Đăng ký hôm qua

＿/＿/＿/＿/＿/＿/＿/

Đăng ký hôm qua

＿/＿/＿/＿/＿/＿/＿/

Thành viên tiêu biểu

Đếm ngược thời gian