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

huevantran · 27/10/22

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

Ronaldinho7 · 27/10/22

huevantran đã viết:
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
và
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é!

snow25 · 27/10/22

huevantran đã viết:
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

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.

bebo021999 · 28/10/22

Đ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

Mã:

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

huevantran · 28/10/22

Zl: 0933707265 đã viết:
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
và
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é!

Em đã chèn thêm câu lệnh anh chỉ dẫn và không còn vướng ý 3 nữa, cảm ơn anh nhiều ạ.

snow25 đã viết:
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.

Em đã có đọc tài liệu tới array, còn dictionary thì em chưa tìm hiểu đến. Cảm ơn anh đã gợi ý.

Bài đã được tự động gộp: 28/10/22

bebo021999 đã viết:

Đ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

Mã:

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

Vâng cháu cảm ơn chú nhiều, rất chi tiết và dễ hiểu ạ. :heart:

ngocbaovu · 28/10/22

Dựa theo code của bạn thì:
1. Mình hiểu là đánh lại số thứ tự trong sheet con nghĩa là số trong cột A thì phải? Trong sheet tổng, A15=ROW()-14. kéo xuống.
2. code "For j = 22 ..." thay bằng "For j = ThisWorkbook.Sheets("Tong").Range("B" & Rows.Count).End(xlUp).Row ...."
3. Tham khảo bài #2

huevantran · 28/10/22

ngocbaovu đã viết:
Dựa theo code của bạn thì:
1. Mình hiểu là đánh lại số thứ tự trong sheet con nghĩa là số trong cột A thì phải? Trong sheet tổng, A15=ROW()-14. kéo xuống.
2. code "For j = 22 ..." thay bằng "For j = ThisWorkbook.Sheets("Tong").Range("B" & Rows.Count).End(xlUp).Row ...."
3. Tham khảo bài #2

Vâng, việc đánh số thứ tự sau khi xem xét lại thì em sử dụng công thức Sheet Tong A15=IF(B15="";"";SUBTOTAL(3;$B$15:B15)) thay vì VBA thì sẽ tiện hơn và đã ổn.
Cảm ơn anh đã giúp em ý số 2. nha.

NguyenNT221100 · 8/3/23

Chào anh @bebo021999
Em copy code của anh về dùng thử thì lần đầu tiên chạy được nhưng hơi chậm (chắc vì dữ liệu của em có khoảng 12 nghìn dòng).
Tuy nhiên ở lần chạy thứ 2 thì máy báo lỗi 1004 và lý do là không copy Sheet được. Em cũng đã copy sheet thủ công nhưng cũng báo lỗi tương tự. Nhờ em hướng dẫn giúp anh cách giải quyết với ạ. (Xin lỗi vì dữ liệu của em có chứa thông tin cần bảo mật cho khách hàng nên em không gởi lên đây được)
Xin lỗi vì sáng sớm đã làm phiền đến anh.

bebo021999 · 8/3/23

NguyenNT221100 đã viết:
Chào anh @bebo021999
Em copy code của anh về dùng thử thì lần đầu tiên chạy được nhưng hơi chậm (chắc vì dữ liệu của em có khoảng 12 nghìn dòng).
Tuy nhiên ở lần chạy thứ 2 thì máy báo lỗi 1004 và lý do là không copy Sheet được. Em cũng đã copy sheet thủ công nhưng cũng báo lỗi tương tự. Nhờ em hướng dẫn giúp anh cách giải quyết với ạ. (Xin lỗi vì dữ liệu của em có chứa thông tin cần bảo mật cho khách hàng nên em không gởi lên đây được)
Xin lỗi vì sáng sớm đã làm phiền đến anh.

Mỗi file 1 khác bạn ơi. Có thể tên sheet của bạn muốn tạo chứa ký tự nào đó mà nó không cho tạo tên sheet.
Thông tin bảo mật, 12k dòng thì bạn delete bớt đi, sau đó thay thông tin khác vào rồi gửi lên cũng được mà.
Tốt nhất bạn nên mở topic mới, sau đó inbox link cho mình nhé.

NguyenNT221100 · 8/3/23

bebo021999 đã viết:
Mỗi file 1 khác bạn ơi. Có thể tên sheet của bạn muốn tạo chứa ký tự nào đó mà nó không cho tạo tên sheet.
Thông tin bảo mật, 12k dòng thì bạn delete bớt đi, sau đó thay thông tin khác vào rồi gửi lên cũng được mà.
Tốt nhất bạn nên mở topic mới, sau đó inbox link cho mình nhé.

Cảm ơn bạn đã phản hồi
Để mình thử lại vài lần với dữ liệu ít hơn xem có giải quyết gì được gì hay không trước khi mở topic mới làm phiền mọi người.
Một lần nữa cảm ơn bạn nhiều nhé.

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

huevantran

Thành viên chính thức

File đính kèm

Ronaldinho7

Zl: 0707315985

snow25

Thành viên gạo cội

bebo021999

Thành viên gạo cội

File đính kèm

huevantran

Thành viên chính thức

ngocbaovu

Thành viên chính thức

huevantran

Thành viên chính thức

NguyenNT221100

Thành viên mới

bebo021999

Thành viên gạo cội

NguyenNT221100

Thành viên mới

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

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