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

Liên hệ QC

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

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
hongphuong1997

hongphuong1997

Thành viên tiêu biểu
Tham gia
12/11/17
Bài viết
777
Được thích
326
Giới tính
Nữ
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ị ạ!
 

File đính kèm

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
 
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
Nhấp chuột vào đây để mở rộng...
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 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?
 
Hoàng Tuấn 868 đã viết:
Thử file này trong lúc đợi nhé.
Nhấp chuột vào đây để mở rộng...
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.
 
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
 
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.
Nhấp chuột vào đây để mở rộng...
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
Nhấp chuột vào đây để mở rộng...
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.
 
Lần chỉnh sửa cuối:
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?
Nhấp chuột vào đây để mở rộ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 . . .
Nhấp chuột vào đây để mở rộng...


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
 
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ừ
Nhấp chuột vào đây để mở rộng...
Thấy con Gấu khóc nhiều quá tớ cũng thử làm.
Chạy Code dưới xem được không nhá!
Chú ý là tên file trong Folder phả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
 

File đính kèm

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ỉ.
Nhấp chuột vào đây để mở rộng...
Code bác "ăn tạp" quá chăng?
Do bác viết theo cách chọn folder, và chỉ định files
Của tôi thì nó lấy tất các files trong folder chứa file Main.
Ù, vậy có lẽ Code tôi mới được gọi là "tạp ăn" mới đúng chứ nhỉ?
 
THÓC SAMA đã viết:
Code bác "ăn tạp" quá chăng?
Do bác viết theo cách chọn folder, và chỉ định files
Của tôi thì nó lấy tất các files trong folder chứa file Main.
Ù, vậy có lẽ Code tôi mới được gọi là "tạp ăn" mới đúng chứ nhỉ?
Nhấp chuột vào đây để mở rộng...
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.
 
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
Nhấp chuột vào đây để mở rộng...
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:

THÓC SAMA đã viết:
Thấy con Gấu khóc nhiều quá tớ cũng thử làm.
Chạy Code dưới xem được không nhá!
Chú ý là tên file trong Folder phả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
Nhấp chuột vào đây để mở rộng...
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.
 
hongphuong1997 đã viết:
nhưng bây giờ em muốn chọn nhiều thư mục một lần..
Nhấp chuột vào đây để mở rộng...
Mình chưa hiểu cách mà bạn chọn nhiều thư mục một lần là làm như thế nào.
Mà mình thấy yêu cầu trong khả năng nên chỉ tham gia góp vui theo thôi bạn còn thêm thêm gì nữa thì có lẽ vượt khả năng của mình rồi ...
 
Hoàng Nhật Phương đã viết:
Mình chưa hiểu cách mà bạn chọn nhiều thư mục một lần là làm như thế nào.
Mà mình thấy yêu cầu trong khả năng nên chỉ tham gia góp vui theo thôi bạn còn thêm thêm gì nữa thì có lẽ vượt khả năng của mình rồi ...
Nhấp chuột vào đây để mở rộng...
Hoàng Nhật Phương đã viết:
folderPath = "C:\Users\OT\Desktop\Folder\" 'Duong dan thu muc chua file excel
Nhấp chuột vào đây để mở rộng...
Em muốn thêm thư mục như này mà không được chị oi
folderPath = "C:\Users\admin\Desktop\New folder" And folderPath = "C:\Users\admin\Desktop\New folder2" 'Duong dan thu muc chua file excel"
 
hongphuong1997 đã viết:
Em muốn thêm thư mục như này mà không được chị oi
folderPath = "C:\Users\admin\Desktop\New folder" And folderPath = "C:\Users\admin\Desktop\New folder2" 'Duong dan thu muc chua file excel"
Nhấp chuột vào đây để mở rộng...
Mình không có nhu cầu nên không giả lập môi trường test,
bạn tham khảo hên thì được còn xui thì thôi nha :
Mã: 
Option Explicit

Sub deleteRows()

    Dim folderName As Variant, folder As Variant
    Dim count As Long
    folderName = Array("C:\Users\admin\Desktop\New folder", "C:\Users\admin\Desktop\New folder2")
    For Each folder In folderName
        count = count + FdeleteRows(folder, "Nguon", "5:8")
    Next folder
    MsgBox count & " File(s) Amended"
   
End Sub

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

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

    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

End Function
 
Hoàng Nhật Phương đã viết:
Mình không có nhu cầu nên không giả lập môi trường test,
bạn tham khảo hên thì được còn xui thì thôi nha :
Mã: 
Option Explicit

Sub deleteRows()

    Dim folderName As Variant, folder As Variant
    Dim count As Long
    folderName = Array("C:\Users\admin\Desktop\New folder", "C:\Users\admin\Desktop\New folder2")
    For Each folder In folderName
        count = count + FdeleteRows(folder, "Nguon", "5:8")
    Next folder
    MsgBox count & " File(s) Amended"
  
End Sub

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

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

    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

End Function
Nhấp chuột vào đây để mở rộng...
Em cảm ơn chị rất nhiều ạ, để chiều em về Test xem sao, em tin chắc là được.
 
hongphuong1997 đã viết:
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:


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.
Nhấp chuột vào đây để mở rộng...
Của bạn đây, vẫn là con Gấu khóc nhiều
Mã: 
Sub ABC()
    Dim MyFolder As String, MyFile As String
    Dim MainWB As Workbook, Wb As Workbook
    Dim Ws As Worksheet, a%
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Set MainWB = ThisWorkbook
    MyFolder = ThisWorkbook.Path
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MyFolderObj = Fso.GetFolder(MyFolder)
    Dim FileNum%
    FileNum = 1
    For Each MyFileObj In MyFolderObj.Files
        If InStr(MyFileObj.Name, ".xlsx") > 0 Then
            If MyFileObj.Name <> MainWB.Name Then
                If FileNum = a + 1 Then
                    MyFile = MyFileObj.Name
                    Workbooks.Open FileName:=MyFolder & "\" & MyFile
                    Set Wb = ActiveWorkbook
                    With Wb
                        For Each Ws In .Worksheets
                            If Ws.Name = "Nguon" Then Rows("5:8").Delete
                        Next
                    End With
                    a = a + 1
                    Wb.Close True
                End If
                FileNum = FileNum + 1
            End If
        End If
    Next MyFileObj
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub
 

File đính kèm

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ỉ.
Nhấp chuột vào đây để mở rộng...
THÓC SAMA đã viết:
Code bác "ăn tạp" quá chăng?
...
Nhấp chuột vào đây để mở rộng...
Tôi nhớ hình như nhược điểm của DIR là nó không thích tiếng có dấu (tiếng Việt, Pháp,... gì cũng không được).

Hoàng Nhật Phương đã viết:
Mình không có nhu cầu nên không giả lập môi trường test,
bạn tham khảo hên thì được còn xui thì thôi nha :
...
Nhấp chuột vào đây để mở rộng...
Sub deleteRows()
Dim thefolder As Variant
Dim countFolders As Long, countFiles As Long
For Each thefolder In Array("C:\Users\admin\Desktop\New folder", "C:\Users\admin\Desktop\New folder2")
countFiles = countFiles + FdeleteRows(thefolder, "Nguon", "5:8")
countFolders = countFolders + 1
Next folder
MsgBox countFiles & " File(s) from " & countFolders & " folders Amended"
End Sub

Chú về thefolder, countFolders, countFiles:
Khi viết code, cố tránh những tên quá đơn giản mà rõ rệt (files, folders, count,...). Bởi vì chúng dễ bị đụng chạm với các code ngầm, hoặc các Enums trong hệ thống. Hôm nay code của bạn có thể suông sẻ nhưng ngày mai, bạn reference một cái thư viện nào đó biết đâu sẽ bị chạm tên.

Chú 2:
Nếu một ngày nào đó, code của bạn bị chạm tên khi đưa vào phiên bản mới của Excel, hãy nhớ lời chú trên. Tìm trong code có những tên đơn giản mà rõ rệt thì 95% là thủ phạm.
 
THÓC SAMA đã viết:
Của bạn đây, vẫn là con Gấu khóc nhiều
Mã: 
Sub ABC()
    Dim MyFolder As String, MyFile As String
    Dim MainWB As Workbook, Wb As Workbook
    Dim Ws As Worksheet, a%
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Set MainWB = ThisWorkbook
    MyFolder = ThisWorkbook.Path
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MyFolderObj = Fso.GetFolder(MyFolder)
    Dim FileNum%
    FileNum = 1
    For Each MyFileObj In MyFolderObj.Files
        If InStr(MyFileObj.Name, ".xlsx") > 0 Then
            If MyFileObj.Name <> MainWB.Name Then
                If FileNum = a + 1 Then
                    MyFile = MyFileObj.Name
                    Workbooks.Open FileName:=MyFolder & "\" & MyFile
                    Set Wb = ActiveWorkbook
                    With Wb
                        For Each Ws In .Worksheets
                            If Ws.Name = "Nguon" Then Rows("5:8").Delete
                        Next
                    End With
                    a = a + 1
                    Wb.Close True
                End If
                FileNum = FileNum + 1
            End If
        End If
    Next MyFileObj
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Nhấp chuột vào đây để mở rộng...
Tôi thấy 2 biến FileNum và a của bạn có vẻ thừa thừa.
 
THÓC SAMA đã viết:
Không biết chỉnh lý lại thì có cần hay không chứ trong code trên thiếu nó là không được bác à.
Nhấp chuột vào đây để mở rộng...
Bạn bỏ cả 2 biến và cái if FileNum = a + 1 đi thử xem. Lý do:

Đầu tiên tất nhiên là đúng rồi vì khi đó FileNum = 1 và a = 0. Khi 2 if bên trên thoả thì tất nhiên a cộng thêm 1 và tiếp đó FileNum cũng cộng thêm 1. Các chu kỳ sau đó cứ mỗi biến lại thêm 1 thì if FileNum = a + 1 luôn luôn thỏa mà.

Không biết tôi có đọc sót chỗ nào không?
 
THÓC SAMA đã viết:
Của bạn đây, vẫn là con Gấu khóc nhiều
Mã: 
Sub ABC()
    Dim MyFolder As String, MyFile As String
    Dim MainWB As Workbook, Wb As Workbook
    Dim Ws As Worksheet, a%
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    Application.AskToUpdateLinks = False
    Application.Calculation = xlCalculationManual
    Set MainWB = ThisWorkbook
    MyFolder = ThisWorkbook.Path
    Set Fso = CreateObject("Scripting.FileSystemObject")
    Set MyFolderObj = Fso.GetFolder(MyFolder)
    Dim FileNum%
    FileNum = 1
    For Each MyFileObj In MyFolderObj.Files
        If InStr(MyFileObj.Name, ".xlsx") > 0 Then
            If MyFileObj.Name <> MainWB.Name Then
                If FileNum = a + 1 Then
                    MyFile = MyFileObj.Name
                    Workbooks.Open FileName:=MyFolder & "\" & MyFile
                    Set Wb = ActiveWorkbook
                    With Wb
                        For Each Ws In .Worksheets
                            If Ws.Name = "Nguon" Then Rows("5:8").Delete
                        Next
                    End With
                    a = a + 1
                    Wb.Close True
                End If
                FileNum = FileNum + 1
            End If
        End If
    Next MyFileObj
    MsgBox "Done"
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Application.AskToUpdateLinks = True
    Application.Calculation = xlCalculationAutomatic
End Sub
Nhấp chuột vào đây để mở rộng...
Em chúc anh ngày mới an lành và nhiều niềm vui hạnh phúc ạ
Anh oi, anh xem lại giúp em với anh
Code không xóa được anh oi
 
hongphuong1997 đã viết:
Em chúc anh ngày mới an lành và nhiều niềm vui hạnh phúc ạ
Anh oi, anh xem lại giúp em với anh
Code không xóa được anh oi
Nhấp chuột vào đây để mở rộng...
Bạn có thể chụp màn hình báo lỗi gửi lên đây được không?
Theo kết quả test code của mình thì code chạy rất "nhiệt tình".
Hình phía dưới là folder chứa file Main (gán code) và các files cần xoá dòng của bạn ở #1.
Bạn tải file main đính kèm về, để chung thư mục với các files cần xoá dòng và chạy code thử xem nha.
Nếu được, bạn gửi luôn đường dẫn folder đang sử dụng lên nha!
1681178992396.png
 

File đính kèm

hongphuong1997 đã viết:
Em muốn thêm thư mục như này mà không được chị oi
folderPath = "C:\Users\admin\Desktop\New folder" And folderPath = "C:\Users\admin\Desktop\New folder2" 'Duong dan thu muc chua file excel"
Nhấp chuột vào đây để mở rộng...
Không biết trên máy khác ra sao chứ trên máy của tôi code (theo gợi ý của Anh @ptm0412) thì thấy chạy cũng êm, nhưng không biết khi chạy code này có gì không ổn không. Nhờ các anh, chị, em thành viên ghé xem và khai sáng cho tôi các vấn đề bất ổn khi sử dụng code này.
Trân trọng cảm ơn!
Mã: 
Option Explicit

Sub XoaDong()

Dim oFile As Variant, afol
Dim fso As Object, Path As String
Dim WbMo As Workbook, i&

Application.DisplayAlerts = False

Set fso = CreateObject("Scripting.FileSystemObject")

Path = ThisWorkbook.Path
afol = Array(, Path & "\New folder1", Path & "\New folder2")

For i = 1 To UBound(afol)
    For Each oFile In fso.GetFolder(afol(i)).Files
        Set WbMo = Workbooks.Open(oFile)
        On Error Resume Next
        If ShExist(ActiveWorkbook, "Nguon") = True Then
            Sheets("Nguon").Rows("3:8").EntireRow.Delete
        End If
    WbMo.Close True
    Next oFile
Next i
Application.DisplayAlerts = True
End Sub

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

File đính kèm

Chỗ:
afol = Array(, Path & "\New folder1", Path & "\New folder2")

For i = 1 To UBound(afol)
Lần đầu tiên tôi thấy "lách" số 0 kiểu này á --=0. Cũng thú vị nhưng không đường đường chính chính lắm :D

Tôi thì tôi cứ hoặc là Option Base 1, hoặc là
afol = Array(Path & "\New folder1", Path & "\New folder2")

For i = 0 To UBound(afol)
 
HUONGHCKT đã viết:
ghé xem
Nhấp chuột vào đây để mở rộng...
PHP: 
Option Explicit

Sub XoaDong()
Const strWsNameTarget = "Nguon"
Const strNameFolder1= "Folder 1"
Const strNameFolder2= "Folder 2"
Dim oFile As object, afol as variant
Dim fso As Object, strPath As String, oFolder as object
Dim WbMo As Workbook, i as long

Application.DisplayAlerts = False

Set fso = CreateObject("Scripting.FileSystemObject")

strPath= ThisWorkbook.Path
afol = Array(fso.BuildPath(strPath,  strNameFolder1), fso.BuildPath(strPath,  strNameFolder2) )

For i = lbound(afol) To UBound(afol)
set oFolder =fso.getFolder(afol(i))
if oFolder.Files.count > 0 then
    For Each oFile in InoFolder.Files
        Set WbMo = Workbooks.Open(oFile.Path)
        If isSheetExists(WbMo, strWsNameTarget) = True Then
            WbMo.Worksheets(strWsNameTarget).Rows("3:8").Delete
           WbMo.Close True
        Else
           WbMo.Close False
        End If
    Next oFile
end if
Next i
Application.DisplayAlerts = True
End Sub

Function isSheetExists(ByVal wb As Workbook, ByVal strWsName As String) As Boolean
Dim Sh As Worksheet
On Error Resume Next
set sh = wb.Worksheets(strWsName)
If Err = 0 Then isSheetExists= True Else: isSheetExists= False
On Error GoTo 0
End Function
 
Maika8008 đã viết:
Chỗ:
afol = Array(, Path & "\New folder1", Path & "\New folder2")

For i = 1 To UBound(afol)
Lần đầu tiên tôi thấy "lách" số 0 kiểu này á --=0. Cũng thú vị nhưng không đường đường chính chính lắm :D

Tôi thì tôi cứ hoặc là Option Base 1, hoặc là
afol = Array(Path & "\New folder1", Path & "\New folder2")

For i = 0 To UBound(afol)
Nhấp chuột vào đây để mở rộng...
befaint đã viết:
PHP: 
Option Explicit

Sub XoaDong()
Const strWsNameTarget = "Nguon"
Const strNameFolder1= "Folder 1"
Const strNameFolder2= "Folder 2"
Dim oFile As object, afol as variant
Dim fso As Object, strPath As String, oFolder as object
Dim WbMo As Workbook, i as long

Application.DisplayAlerts = False

Set fso = CreateObject("Scripting.FileSystemObject")

strPath= ThisWorkbook.Path
afol = Array(fso.BuildPath(strPath,  strNameFolder1), fso.BuildPath(strPath,  strNameFolder2) )

For i = lbound(afol) To UBound(afol)
set oFolder =fso.getFolder(afol(i))
if oFolder.Files.count > 0 then
    For Each oFile in InoFolder.Files
        Set WbMo = Workbooks.Open(oFile.Path)
        If isSheetExists(WbMo, strWsNameTarget) = True Then
            WbMo.Worksheets(strWsNameTarget).Rows("3:8").Delete
           WbMo.Close True
        Else
           WbMo.Close False
        End If
    Next oFile
end if
Next i
Application.DisplayAlerts = True
End Sub

Function isSheetExists(ByVal wb As Workbook, ByVal strWsName As String) As Boolean
Dim Sh As Worksheet
On Error Resume Next
set sh = wb.Worksheets(strWsName)
If Err = 0 Then isSheetExists= True Else: isSheetExists= False
On Error GoTo 0
End Function
Nhấp chuột vào đây để mở rộng...
Cảm ơn các anh đã xem bài và khai sáng.
 
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.

Bài viết mới nhất

N
  • Question Question
Sự kiện keydown & textbox user form (2 người xem)
Trả lời
0
Đọc
19
nguyenduy39
N
T
  • Question Question
Kết quả lọc dữ liệu từ sheet TONG HOP qua từng chi tiết
Trả lời
1
Đọc
38
HUONGHCKT
H
S
Cảm ơn Admin đã duyệt (1 người xem)
Trả lời
0
Đọc
29
samthai8017
S
S
Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới). Thank
Trả lời
4
Đọc
59
samthai8017
S
S
Xin các Pro chia sẻ giúp
Trả lời
4
Đọc
65
samthai8017
S
GPE-Trợ Lý
TALKSHOW 16 BẬT MÍ THỦ THUẬT GOOGLE SHEET: TỔNG HỢP DỮ LIỆU TỪ NHIỀU SHEET & FILE BĂNG IMPORTRANGE
Trả lời
1
Đọc
486
GPE-Trợ Lý
GPE-Trợ Lý
B
Em nhờ các bro giúp giải pháp in nhiều file ạ
Trả lời
3
Đọc
62
Hoàng Tuấn 868
H
T
  • Question Question
Code VBA tra cứu kết quả trả về mảng dữ liệu
    • Cười
Trả lời
17
Đọc
327
LOGANWover
L
HeSanbi
  • Question Question
VBScript.RegExp sẽ bị xóa khỏi Windows: thư viện Pcre2 giải pháp thay thế tối ưu
    • Thích
    • Cảm ơn
Trả lời
1
Đọc
80
HeSanbi
HeSanbi
S
Xin hỏi các pro. Em muốn copy các dữ liệu ô họ tên đã bị gộp từ B9 đến E9. Em muốn pass sang ô B9 (sheet mới).
Trả lời
3
Đọc
61
samthai8017
S
T
Nhờ anh chị tìm giúp nguyên nhân không nhảy dữ liệu Pivotable
Trả lời
2
Đọc
73
thuhacoicoi
T
HeSanbi
  • Question Question
Chuyển mã VBA ứng dụng Excel 32 bit hoạt động trên cả 64bit (Hoàn toàn 0 phí)
    • Thích
Trả lời
0
Đọc
62
HeSanbi
HeSanbi
T
Ctrl + Shift + 0 không dùng để unhide cột được
Trả lời
24
Đọc
22K
Oji
O
quangminhici
Tặng Addin Word xuất Mail Merge có chức năng cắt ra nhiều file và gửi mail.
    • Thích
    • Yêu thích
Trả lời
19
Đọc
4K
Hoàng Tuấn 868
H
Gà Công Nghệ
Nhờ anh chị chuyển hộ font chữ excel
Trả lời
3
Đọc
99
HeSanbi
HeSanbi
huytamlinh
Anh Chị giúp em sửa lỗi định dạng với ạ !
Trả lời
3
Đọc
51
Hoàng Tuấn 868
H
T
  • Question Question
Xin giúp em mã lệnh tổng hợp tự động lên bảng tổng hợp!
Trả lời
1
Đọc
61
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính
    • Thích
Trả lời
4
Đọc
926
nguyendang95
N
V
Quản lý xuất nhập vật tư trong kho
Trả lời
19
Đọc
768
LOGANWover
L
phuongnam366377
Học C++ từ số 0 – Bài học đầu tiên
    • Cảm ơn
Trả lời
4
Đọc
357
phuongnam366377
phuongnam366377
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Thời gian đếm ngược.

000
Ngày
00
Giờ
00
phút
00
giây
Thân mời tham dự sự kiện sinh nhật GPE 2025
Back
Top Bottom