Giúp em xóa file trong thư mục và xóa dòng trong một sheet với ạ

[nvtruong.lg2]

Các bác giúp em xử lý công việc này với ạ, giờ em có những file excel như đính kèm ở dưới giờ em muốn xóa đồng thời các sheet 2, 3, 4, 5 (để lại sheet 1 "KeKhaiDangKy") trong các file excel và xóa dòng 1,2,4 trong sheet1 "KeKhaiDangKy" trong các file cùng, nhiều file chứa trong 1 thư mục (Kết quả mong muốn giống như file KetQua_dc12.xlsx ạ)

 

[HUONGHCKT]

Các bác giúp em xử lý công việc này với ạ, giờ em có những file excel như đính kèm ở dưới giờ em muốn xóa đồng thời các sheet 2, 3, 4, 5 (để lại sheet 1 "KeKhaiDangKy") trong các file excel và xóa dòng 1,2,4 trong sheet1 "KeKhaiDangKy" trong các file cùng, nhiều file chứa trong 1 thư mục (Kết quả mong muốn giống như file KetQua_dc12.xlsx ạ)

Bạn mở từng file lên và xóa 1 lần tất cả các SH không phải là "KeKhaiDangKy bằng cách
Click Chuột vào tên Sh sau Sh("KeKhai..." giữ phím Shift và chọn đến Sh cuối cùng, phải chuột chọn Delete ==> xong phần xóa sh.
Xóa 1 lần các dòng cần xóa: Vào Sh chọn dòng cần xóa(click chuột vào biên trái)\Giữ phím Ctrl\Chọn các dòng tiếp theo\Phải chuột\chọn Delete ==> xóa xong.
Còn nếu muốn đang ở một sh nào đó mà muốn xóa tất cả các Sh, các dòng cần xóa ở những file khác (không cần mở file đó) thì phải dùng bằng VBA.

 

[nvtruong.lg2]

Bạn mở từng file lên và xóa 1 lần tất cả các SH không phải là "KeKhaiDangKy bằng cách
Click Chuột vào tên Sh sau Sh("KeKhai..." giữ phím Shift và chọn đến Sh cuối cùng, phải chuột chọn Delete ==> xong phần xóa sh.
Xóa 1 lần các dòng cần xóa: Vào Sh chọn dòng cần xóa(click chuột vào biên trái)\Giữ phím Ctrl\Chọn các dòng tiếp theo\Phải chuột\chọn Delete ==> xóa xong.
Còn nếu muốn đang ở một sh nào đó mà muốn xóa tất cả các Sh, các dòng cần xóa ở những file khác (không cần mở file đó) thì phải dùng bằng VBA.

Do số lượng file có cùng cấu trúc có lên đến hàng 100 file nên làm thủ công từng file rất lâu, nên mình muốn không mở file mà có thể xóa đồng loạt ở các file ý

 

[BuiQuangThuan]

Do số lượng file có cùng cấu trúc có lên đến hàng 100 file nên làm thủ công từng file rất lâu, nên mình muốn không mở file mà có thể xóa đồng loạt ở các file ý

Xin lỗi. Mình hiểu bạn muốn gì rồi.. Là do mình nhầm

 

[HUONGHCKT]

Do số lượng file có cùng cấu trúc có lên đến hàng 100 file nên làm thủ công từng file rất lâu, nên mình muốn không mở file mà có thể xóa đồng loạt ở các file ý

[Sub DELETE_Sh_In_FILES()
Dim wb As Workbook
Dim sh As Worksheet, ws As Worksheet
Dim sPat As String, swb As String
Dim lr&
Application.DisplayAlerts = False
Set sh = Sheets("THU NGHIEM")
sPat = sh.[J1]
If sh.[B3] = Empty And Application.CountIf(sh.Range("J2:J11000"), "<>") = 0 Then Exit Sub
If sh.[B3] = Empty And Application.CountIf(sh.Range("J2:J1000"), "<>") <> 0 Then
Dim ThongBao&
ThongBao = MsgBox(" Ban có muôn xóa các file trong dai ô J2:J... cua sheet này không?", vbYesNo, "Thông báo")
If ThongBao = 6 Then
For i = 2 To sh.[J100].End(3).Row
swb = sh.Range("J" & i) & ".xlsx"
Set wb = Workbooks.Open(sPat & swb)
For Each ws In wb.Worksheets
If ws.Name <> "KeKhaiDangKy" Then
ws.DELETE
End If

'==========================Doan này xóa các dòng cân xóa n?u mu?n xóa thì b? các d?u ' ? ??u dong
' If ws.Name = "KeKhaDangKy" Then
' Range("9:9,7:7").Select ' Dua các dòng vao danh sách xóa
' Selection.DELETE Shift:=xlUp
' End If
Next ws
wb.Close False
Next i
End If
End If
Application.DisplayAlerts = False
MsgBox " DÃ XÓA XONG"
End Sub]

Mình thử ở máy mình thì chạy rồi. bạn muốn thử thì nên copy 1 số file ra một bản sao nữa và chạy thử. nếu thấy ổn thì mới cho chạy bản chính. Cũng đáng thử nếu số lượng file và sh trong từng file đó nhiều.
Lưu ý :
1/ Ở Modul DELETESHEETS bạn chỉ cần nhập đường dẫn và tên file vào cột J. (đường dẫn của đến file cần xóa phải ghi đúng vào Ô J1, ô J2,J3 là tên các file ấy.)
2/ Ở Modul XOA_Sh_in_File bạn cần bôi đen các file cần xóa sh và nhấn nút open.
3/ Trong cả 2 cách: Các dòng cần xóa: bạn mở code và thay đổi (nhớ bỏ dấu " ' " ở trước các dòng code.

Hy vọng 2 cách này sẽ giúp ích được cho bạn. Chúc bạn thành công.

P/S; Code của các anh chị trên diễn đàn tôi chỉ copy về và xào xáo lại một tý cho phù hợp với nhu cầu sử dụng.

 

[HieuCD]

Các bác giúp em xử lý công việc này với ạ, giờ em có những file excel như đính kèm ở dưới giờ em muốn xóa đồng thời các sheet 2, 3, 4, 5 (để lại sheet 1 "KeKhaiDangKy") trong các file excel và xóa dòng 1,2,4 trong sheet1 "KeKhaiDangKy" trong các file cùng, nhiều file chứa trong 1 thư mục (Kết quả mong muốn giống như file KetQua_dc12.xlsx ạ)

Sub XoaSheet()
  Dim fso As Object, ObjFile As Object, wb As Workbook, sh As Worksheet, DieuKienXoaDong$
 
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Chon Folder chua các file cân tông hop"
    .AllowMultiSelect = True
    If .Show = -1 Then strFolder = .SelectedItems(1)
  End With
  If strFolder <> Empty Then
    DieuKienXoaDong = Range("C1").Value 'Loai tru xoa nhieu lan
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso.GetFolder(strFolder)
      For Each ObjFile In .Files
        If fso.GetExtensionName(ObjFile) Like "xlsx" Then
          Set wb = Workbooks.Open(ObjFile)
          For Each sh In wb.Sheets
            If sh.Name = "KeKhaiDangKy" Then
              If sh.Range("C3") = DieuKienXoaDong Then 'Chua Xoa
                sh.Range("A4").EntireRow.Delete
                sh.Range("A1:A2").EntireRow.Delete
              End If
            Else
              sh.Delete
            End If
          Next sh
          wb.Close true
        End If
      Next ObjFile
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
   End With
  End If
End Sub

Mở file dưới, chạy code, chọn folder chứa các file cần xóa

 

[HUONGHCKT]

Sub XoaSheet()
  Dim fso As Object, ObjFile As Object, wb As Workbook, sh As Worksheet, DieuKienXoaDong$
 
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Chon Folder chua các file cân tông hop"
    .AllowMultiSelect = True
    If .Show = -1 Then strFolder = .SelectedItems(1)
  End With
  If strFolder <> Empty Then
    DieuKienXoaDong = Range("C1").Value 'Loai tru xoa nhieu lan
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso.GetFolder(strFolder)
      For Each ObjFile In .Files
        If fso.GetExtensionName(ObjFile) Like "xlsx" Then
          Set wb = Workbooks.Open(ObjFile)
          For Each sh In wb.Sheets
            If sh.Name = "KeKhaiDangKy" Then
              If sh.Range("C3") = DieuKienXoaDong Then 'Chua Xoa
                sh.Range("A4").EntireRow.Delete
                sh.Range("A1:A2").EntireRow.Delete
              End If
            Else
              sh.Delete
            End If
          Next sh
          wb.Close False
        End If
      Next ObjFile
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
   End With
  End If
End Sub

Mở file dưới, chạy code, chọn folder chứa các file cần xóa

Tuyệt vời, đúng là chuyên gia Excel viết code có khác, ngắn gọn, dễ hiểu và đặc biệt là tính hiệu quả. Tin chắc rằng không chỉ chủ thớt cần dùng mà sẽ rất hữu ích cho nhiều bạn khác nữa.

 

[BuiQuangThuan]

Sub XoaSheet()
  Dim fso As Object, ObjFile As Object, wb As Workbook, sh As Worksheet, DieuKienXoaDong$
 
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Chon Folder chua các file cân tông hop"
    .AllowMultiSelect = True
    If .Show = -1 Then strFolder = .SelectedItems(1)
  End With
  If strFolder <> Empty Then
    DieuKienXoaDong = Range("C1").Value 'Loai tru xoa nhieu lan
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso.GetFolder(strFolder)
      For Each ObjFile In .Files
        If fso.GetExtensionName(ObjFile) Like "xlsx" Then
          Set wb = Workbooks.Open(ObjFile)
          For Each sh In wb.Sheets
            If sh.Name = "KeKhaiDangKy" Then
              If sh.Range("C3") = DieuKienXoaDong Then 'Chua Xoa
                sh.Range("A4").EntireRow.Delete
                sh.Range("A1:A2").EntireRow.Delete
              End If
            Else
              sh.Delete
            End If
          Next sh
          wb.Close False
        End If
      Next ObjFile
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
   End With
  End If
End Sub

Thầy ơi. cái này phải là true thì phải.

wb.Close True

 

[HieuCD]

Thầy ơi. cái này phải là true thì phải.

wb.Close True

Mình chạy thử không lưu nên cho = False quên chỉnh lại. Chúc bạn và gia đình vui khỏe

 

[nvtruong.lg2]

[Sub DELETE_Sh_In_FILES()
Dim wb As Workbook
Dim sh As Worksheet, ws As Worksheet
Dim sPat As String, swb As String
Dim lr&
Application.DisplayAlerts = False
Set sh = Sheets("THU NGHIEM")
sPat = sh.[J1]
If sh.[B3] = Empty And Application.CountIf(sh.Range("J2:J11000"), "<>") = 0 Then Exit Sub
If sh.[B3] = Empty And Application.CountIf(sh.Range("J2:J1000"), "<>") <> 0 Then
Dim ThongBao&
ThongBao = MsgBox(" Ban có muôn xóa các file trong dai ô J2:J... cua sheet này không?", vbYesNo, "Thông báo")
If ThongBao = 6 Then
For i = 2 To sh.[J100].End(3).Row
swb = sh.Range("J" & i) & ".xlsx"
Set wb = Workbooks.Open(sPat & swb)
For Each ws In wb.Worksheets
If ws.Name <> "KeKhaiDangKy" Then
ws.DELETE
End If

'==========================Doan này xóa các dòng cân xóa n?u mu?n xóa thì b? các d?u ' ? ??u dong
' If ws.Name = "KeKhaDangKy" Then
' Range("9:9,7:7").Select ' Dua các dòng vao danh sách xóa
' Selection.DELETE Shift:=xlUp
' End If
Next ws
wb.Close False
Next i
End If
End If
Application.DisplayAlerts = False
MsgBox " DÃ XÓA XONG"
End Sub]

Mình thử ở máy mình thì chạy rồi. bạn muốn thử thì nên copy 1 số file ra một bản sao nữa và chạy thử. nếu thấy ổn thì mới cho chạy bản chính. Cũng đáng thử nếu số lượng file và sh trong từng file đó nhiều.
Lưu ý :
1/ Ở Modul DELETESHEETS bạn chỉ cần nhập đường dẫn và tên file vào cột J. (đường dẫn của đến file cần xóa phải ghi đúng vào Ô J1, ô J2,J3 là tên các file ấy.)
2/ Ở Modul XOA_Sh_in_File bạn cần bôi đen các file cần xóa sh và nhấn nút open.
3/ Trong cả 2 cách: Các dòng cần xóa: bạn mở code và thay đổi (nhớ bỏ dấu " ' " ở trước các dòng code.

Hy vọng 2 cách này sẽ giúp ích được cho bạn. Chúc bạn thành công.

P/S; Code của các anh chị trên diễn đàn tôi chỉ copy về và xào xáo lại một tý cho phù hợp với nhu cầu sử dụng.

Dạ cảm ơn bạn đã hỗ trợ!

 

[nvtruong.lg2]

Sub XoaSheet()
  Dim fso As Object, ObjFile As Object, wb As Workbook, sh As Worksheet, DieuKienXoaDong$
 
  With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Chon Folder chua các file cân tông hop"
    .AllowMultiSelect = True
    If .Show = -1 Then strFolder = .SelectedItems(1)
  End With
  If strFolder <> Empty Then
    DieuKienXoaDong = Range("C1").Value 'Loai tru xoa nhieu lan
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    With fso.GetFolder(strFolder)
      For Each ObjFile In .Files
        If fso.GetExtensionName(ObjFile) Like "xlsx" Then
          Set wb = Workbooks.Open(ObjFile)
          For Each sh In wb.Sheets
            If sh.Name = "KeKhaiDangKy" Then
              If sh.Range("C3") = DieuKienXoaDong Then 'Chua Xoa
                sh.Range("A4").EntireRow.Delete
                sh.Range("A1:A2").EntireRow.Delete
              End If
            Else
              sh.Delete
            End If
          Next sh
          wb.Close true
        End If
      Next ObjFile
      Application.ScreenUpdating = True
      Application.DisplayAlerts = True
   End With
  End If
End Sub

Mở file dưới, chạy code, chọn folder chứa các file cần xóa

TUYỆT VỜI Ạ, CẢM ƠN BẠN HIEUCD ĐÃ HỖ TRỢ!