Xin tư vấn một số vướng mắc khi chia sheet tổng thành nhiều sheet nhỏ

Chia sẻ bởi:hands
★★★★★
Quảng cáo

Chào tất cả các Anh Chị thành viên GPE,

Em mới tập viết Code VBA gần đây, hiện tại em có nhu cầu muốn tách 1 file tổng thành nhiều file nhỏ hơn có điều kiện, em còn 1 số vấn đề chưa mày mò được, nhờ các Anh Chị chỉ giúp:
1. Em chưa biết cách đánh lại số thứ tự cho các sheet con sau khi tách
2. Giá trị lớn nhất của biến j hiện tại em đang thiết lập cố định là 22 tương ứng với hàng cuối cùng chứa dữ liệu trong bảng của sheet Tong. Làm thế nào để có thể lấy được giá trị này tự động.
3. Làm sao để tắt thông báo khi delete sheet.

Mong nhận được sự giúp đỡ từ các Anh Chị, em cảm ơn.

Sub ABC()

Dim i As Integer
Dim j As Integer
Dim nsd As String
Dim bp As String

For Each Worksheet In ThisWorkbook.Worksheets
       If Worksheet.Name <> "Tong" And Worksheet.Name <> "DS" Then
          Worksheet.Delete
       End If
   Next
For i = 1 To WorksheetFunction.CountA(ThisWorkbook.Sheets("DS").Range("A2:A100"))
nsd = ThisWorkbook.Sheets("DS").Range("A" & i + 1).Value
bp = ThisWorkbook.Sheets("DS").Range("B" & i + 1).Value
     Sheets("Tong").Copy After:=Sheets(i + 1)
     For j = 22 To 15 Step -1
     If Cells(j, 4) <> nsd Then
     Rows(j).Delete
     End If
     Next j
     Range("A2") = bp
     ActiveSheet.Name = nsd
Next i

End Sub

Bạn thêm
Application.ScreenUpdating = False 'tắt chế độ cập nhật màn hình
Application.DisplayAlerts = False 'tắt cảnh báo
vào đầu chương trình

Application.ScreenUpdating = true 'bật chế độ cập nhật màn hình
Application.DisplayAlerts = true 'bật cảnh báo
vào cuối chương trình nhé!

Nghiên cứu tách theo mảng array và dictionary nhé.Mà tách thì cần thêm 1 sheets mẫu chỉ điền dữ,liệu không cần format lại.

Đi theo hướng này nhé:
1) copy sheet Tong cho mỗi nơi SD 1 sheet
2) Trong từng sheet, delete các dòng không liên quan

Sub ABC()
Dim lr&, lr1&
Dim ws As Worksheet, cell As Range, cellb As Range
For Each ws In Sheets
   If ws.Name <> "Tong" And ws.Name <> "DS" Then
      ws.Delete
   End If
Next
lr = Sheets("DS").Cells(Rows.Count, "A").End(xlUp).Row ' dong cuoi cua sheet DS
For Each cell In Sheets("DS").Range("A2:A" & lr) ' duyet qua tung noi su dung
    Sheets("Tong").Copy after:=Sheets(Sheets.Count) ' copy sheet Tong qua sheet moi, sau do delete cac dong khong lien quan
    With ActiveSheet
        .Name = cell.Value ' dat ten sheet
        lr1 = .Cells(Rows.Count, "C").End(xlUp).Row 'dong cuoi
        For Each cellb In .Range("D15:D" & lr1) 'duyet qua tung o va so sanh voi noi su dung
            If cellb.Value <> cell.Value Then cellb.ClearContents ' xoa trong o neu khac noi su dung
        Next
        .Range("D15:D" & lr1).SpecialCells(xlBlanks).EntireRow.Delete ' xoa cac o trong trong cot D
    End With
Next
End Sub

www.giaiphapexcel.com/diendan/threads/xin-t%C6%B0-v%E1%BA%A5n-m%E1%BB%99t-s%E1%BB%91-v%C6%B0%E1%BB%9Bng-m%E1%BA%AFc-khi-chia-sheet-t%E1%BB%95ng-th%C3%A0nh-nhi%E1%BB%81u-sheet-nh%E1%BB%8F.162693/

Khoá học Trưởng phòng nhân sự
Khóa học SprinGO phù hợp

Khoá học Trưởng phòng nhân sự

Nguồn nhân lực là một trong Tứ trụ kinh doanh của doanh nghiệp, có tác động tới sự tồn tại và phát triển bền...

Xem khóa học
★★★★★ 5 ★ 1 👤 1 ▥ 0
Quảng cáo

Bạn nên đọc

Bình luận

Quảng cáo

Cũ vẫn chất

Xem thêm