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.
Em muốn thêm thư mục như này mà không được chị oi
Mình không có nhu cầu nên không giả lập môi trường test,
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 FunctionEm cảm ơn chị rất nhiều ạ, để chiều em về Test xem sao, em tin chắc là được.
Để xong ngay thì các bác.Cũng luyện tập và học hỏi cả mấy tháng.Có khi mất cả năm nha bạn.
Của bạn đây, vẫn là con Gấu khóc nhiều
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 SubTô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).
Sub deleteRows()
Vì thế mới có #20 và #26 đấy bác.
Tôi thấy 2 biến FileNum và a của bạn có vẻ thừa thừa.
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 à.
Bạn bỏ cả 2 biến và cái if FileNum = a + 1 đi thử xem. Lý do:
Em chúc anh ngày mới an lành và nhiều niềm vui hạnh phúc ạ
Bạn có thể chụp màn hình báo lỗi gửi lên đây được khô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.
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
. Cũng thú vị nhưng không đường đường chính chính lắm 
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 FunctionChỗ:
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 á
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)
Cảm ơn các anh đã xem bài và khai sáng.
