Tách 1 sheet thành nhiều sheet theo điều kiện (1 người xem)

Elx 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)
nguyendinhtutw

nguyendinhtutw

Thành viên chính thức
Tham gia
17/4/17
Bài viết
73
Được thích
3
Giới tính
Nam
Dear các bác,
Em có 1 file excel như đính kèm, bây giờ em muốn tách sheet "Tong hop" thành các sheet (tạm gọi là "sheet con") dựa theo tên của người quản lý sao cho:
- Khi thay đổi nội dung ở các sheet con (Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo.
Các bác giúp em với ạ. Em cảm ơn các bác!
Trân trọng,
 

File đính kèm

Sắp xếp theo thời gian sắp xếp theo bầu chọn
Nên chăng tách từ Sheet 'TongHop' vô 1 trang chi tiết; Nhưng thể hiện 'Người quản lí' nào đó mà bạn muốn;
 
Upvote 0
1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần.
2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau
a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau)
b. Xóa nội dung của TongHop
c. Chép nội dung mọi sheet con về sheet TongHop.
 
Upvote 0
haonlh đã viết:
1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần.
2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau
a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau)
b. Xóa nội dung của TongHop
c. Chép nội dung mọi sheet con về sheet TongHop.
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác, bác có thể giúp em đoạn code này không? em cũng đang tìm hiểu trên mạng nhưng em còn quá yếu về VBA nên chưa thể tự làm được việc này. Em cảm ơn!
 
Upvote 0
haonlh đã viết:
1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần.
2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau
a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau)
b. Xóa nội dung của TongHop
c. Chép nội dung mọi sheet con về sheet TongHop.
Nhấp chuột vào đây để mở rộng...

Mục b, và c cứ làm thế thôi, chứ không biết chính xác được sheet con có chỉnh sửa hay không phải không Anh.
 
Upvote 0
haonlh đã viết:
1. Chuyện tách sheet TongHop thành các sheet con là đơn giản. Như vậy các sheet con đều có cùng khuôn dạng. Chương trình này chỉ cần làm 1 lần.
2. Mỗi khi thay đổi nội dung ở các sheet con ( Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo thì làm theo sơ đồ sau
a. Lập sự kiện Worksheet_Activate cho TongHop (viết code cho sự kiện này, gồm 2 mục sau)
b. Xóa nội dung của TongHop
c. Chép nội dung mọi sheet con về sheet TongHop.
Nhấp chuột vào đây để mở rộng...

Mình triển khai ý thứ b và c của Anh. các bạn hỗ trợ ý a nhé.

PHP: 
Private Sub Worksheet_Activate()
    Dim Wks As Worksheet
    Range("A3:G10000").ClearContents
    For Each Wks In Worksheets
        If Wks.Name <> "Tong hop" Then
            Wks.Range("A3", Wks.Range("C60000").End(xlUp)).Resize(, 5).Copy
            Sheets("Tong hop").Range("C60000").End(xlUp).Offset(1, -2).PasteSpecial xlPasteValues
        End If
    Next Wks
End Sub
 

File đính kèm

Upvote 0
nguyendinhtutw đã viết:
Dear các bác,
Em có 1 file excel như đính kèm, bây giờ em muốn tách sheet "Tong hop" thành các sheet (tạm gọi là "sheet con") dựa theo tên của người quản lý sao cho:
- Khi thay đổi nội dung ở các sheet con (Chỉnh sửa nội dung trong cell, insert/delete dòng) thì sheet "Tong hop" cũng thay đổi theo.
Các bác giúp em với ạ. Em cảm ơn các bác!
Trân trọng,
Nhấp chuột vào đây để mở rộng...
Mình tách ra như File đính kèm.
Code em viết còn lung tung quá, các anh chị giúp em thay đổi với.
Ý tưởng của Em thế này.
- Em cho cột Họ và Tên vào 1 đối tượng Dictionary
- Em duyệt một mảng lấy từng dòng họ và Tên so với Họ và tên đã lưu trong Dictionary
- Sau khi so ra kết quả, Em Add vào một mảng mới
- Add new sheet, để dán cái mảng đó xuống bảng tính.

Mã: 
Sub SplitSheet()
    Dim Dic As New Dictionary
    Dim sFullName(), dFullName()
    Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer
    sFullName = Sheets("Tonghop").Range("A3:G20").Value
    ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2))
    '----------------------------------------------------------------------
    For i = 1 To UBound(sFullName, 1)
        If Not Dic.Exists(sFullName(i, 3)) Then
            Dic.Add sFullName(i, 3), ""
        End If
    Next i
    '----------------------------------------------------------------------
    For j = 1 To Dic.Count
        For k = 1 To UBound(sFullName, 1)
            If sFullName(k, 3) = Dic.Keys()(j - 1) Then
                m = m + 1
                For n = 1 To 7
                    dFullName(m, n) = sFullName(k, n)
                Next n
            End If
        Next k
       Worksheets.Add After:=Sheets("Tonghop")
       ActiveSheet.Range("A3").Resize(18, 7) = dFullName
       ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2))
       k = 0: m = 0: n = 0
    Next j
End Sub
 

File đính kèm

Upvote 0
phuyen89 đã viết:
Mình tách ra như File đính kèm.
Code em viết còn lung tung quá, các anh chị giúp em thay đổi với.
Ý tưởng của Em thế này.
- Em cho cột Họ và Tên vào 1 đối tượng Dictionary
- Em duyệt một mảng lấy từng dòng họ và Tên so với Họ và tên đã lưu trong Dictionary
- Sau khi so ra kết quả, Em Add vào một mảng mới
- Add new sheet, để dán cái mảng đó xuống bảng tính.

Mã: 
Sub SplitSheet()
    Dim Dic As New Dictionary
    Dim sFullName(), dFullName()
    Dim i As Integer, j As Integer, k As Integer, m As Integer, n As Integer
    sFullName = Sheets("Tonghop").Range("A3:G20").Value
    ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2))
    '----------------------------------------------------------------------
    For i = 1 To UBound(sFullName, 1)
        If Not Dic.Exists(sFullName(i, 3)) Then
            Dic.Add sFullName(i, 3), ""
        End If
    Next i
    '----------------------------------------------------------------------
    For j = 1 To Dic.Count
        For k = 1 To UBound(sFullName, 1)
            If sFullName(k, 3) = Dic.Keys()(j - 1) Then
                m = m + 1
                For n = 1 To 7
                    dFullName(m, n) = sFullName(k, n)
                Next n
            End If
        Next k
       Worksheets.Add After:=Sheets("Tonghop")
       ActiveSheet.Range("A3").Resize(18, 7) = dFullName
       ReDim dFullName(1 To UBound(sFullName, 1), 1 To UBound(sFullName, 2))
       k = 0: m = 0: n = 0
    Next j
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn phuyen89, tuy nhiên, sau khi xem file của bác em thấy có các vấn đề sau:
- Khi click commandbutton nhiều lần thì sheet cũng bị tách theo từng đó lần.
- Khi chỉnh sửa giữ liệu trên các Sheet con thì Sheet "Tonghop" chưa được cập nhật.
 
Upvote 0
nguyendinhtutw đã viết:
Cảm ơn phuyen89, tuy nhiên, sau khi xem file của bác em thấy có các vấn đề sau:
- Khi click commandbutton nhiều lần thì sheet cũng bị tách theo từng đó lần.
- Khi chỉnh sửa giữ liệu trên các Sheet con thì Sheet "Tonghop" chưa được cập nhật.
Nhấp chuột vào đây để mở rộng...

+ Mình tiến hành Xoá Sheet trước khi Tạo ra.
PHP: 
Private Sub Delete_Sheet()
    Application.DisplayAlerts = True
    Dim Wks As Worksheet
    For Each Wks In Worksheets
        If Wks.Name <> "Tonghop" Then
            Wks.Delete
        End If
    Application.DisplayAlerts = False
    Next Wks
End Sub
 

File đính kèm

Upvote 0
hpkhuong đã viết:
- Click thì phải biết tự lượng sức. Click rồi thì đừng Click nữa??? Tại sao không kiểm soát mình làm những gì?
- Không ai làm 2 chiều. 1 là Sheet Tổng Hợp chuẩn -> Tách ra sheet con. 2 là Các sheet con có sẵn (và là chuẩn) -> Chạy code dữ liệu sẽ tổng hợp về sheet Tổng Hợp.
Coi chừng làm kiểu nữa vời 2 chiều có ngày ăn "Hành" đó...

Ghi chú: tôi chỉ góp ý, chứ không biết làm nha!
Nhấp chuột vào đây để mở rộng...
Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con
 
Upvote 0
nguyendinhtutw đã viết:
Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con
Nhấp chuột vào đây để mở rộng...
1 sheet TONGHOP, muốn tìm người nào thì Auto Filter người đó, nhập thêm dữ liệu hay xóa dòng "mút chỉ", Sort lại 1 phát là "gom".
 
Upvote 0
Em có tìm hiểu được trên mạng và làm được bảng như đính kèm, tuy nhiên mới chỉ tách được tiêu đề, chưa tách được nội dung, các bác xem giúp em xem đang bị sai chỗ nào với ạ.
 

File đính kèm

Upvote 0
nguyendinhtutw đã viết:
Cảm ơn bác, nhưng em lưu ý là việc tách này chỉ làm 1 lần, để áp dụng cho dữ liệu hiện đã có sẵn trong sheet "tonghop", kể từ sau này thì sẽ không cập nhật dữ liệu mới trực tiếp vào sheet "tong hop" nữa, mà việc này sẽ được thực hiện thông qua việc cập nhật ở các Sheet con
Nhấp chuột vào đây để mở rộng...
Tôi thấy cảnh bảo của @hpkhuong không sai đâu, bạn đang làm ngược đấy.
Bạn nên dùng sheets Tổng hợp để theo dõi mọi số liệu, sau mỗi lần thay đổi số liệu, bạn cập nhật lại vào các Sheet con là cách hay hơn.
Tôi sẽ làm qua các bước sau:
- Bước 1: Dùng lệnh Offset để tạo Name động cho vùng dữ liệu của Bảng tổng hợp
- Bước 2: Tạo 1 sheet PivotTable để tạo Pivot Table
- Bước 3: Dùng code của @kyo để bảng Pivot Table có thể tự động cập nhật khi dữ liệu nguồn thay đổi
- Bước 4: Dùng code của @be09 để tách sheets theo Pivot Table
Khi dữ liệu ở Sheet Tong hop thay đổi, bạn click lại nút Tách Sheets là các dữ liệu con sẽ thay đổi theo
Bạn xem file đính kèm nhé!
 

File đính kèm

Upvote 0
hpkhuong đã viết:
1. Chạy code này để tách (chạy 1 lần đầu thôi).
Mã: 
Public Sub Tach_Sheet()
Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each Ws In Worksheets
    If Ws.Name <> "Tong hop" Then Ws.Delete
Next
sArr = Range("C3", Range("C3").End(4)).Value
Set Rng = Range("A2").CurrentRegion
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
    Tmp = sArr(I, 1)
        If Not Dic.exists(Tmp) Then
            Dic.Add Tmp, ""
            Rng.AutoFilter 3, Tmp
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Tmp
            Rng.SpecialCells(12).Copy
            Sheets(Tmp).Range("A2").PasteSpecial 8
            Sheets(Tmp).Range("A2").PasteSpecial xlPasteAll
        End If
    End If
    Next
Sheet1.Activate
Sheet1.ShowAllData
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

2. Code này copy vào sheet "Tong hop". Cập nhật dữ liệu ở sheet con sẽ tự động chạy về tổng hợp

Mã: 
Private Sub Worksheet_Activate()
Dim sArr, dArr(1 To 65000, 1 To 7), I As Long, J As Long, K As Long, Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
    If Ws.Name <> "Tong hop" Then
        sArr = Ws.Range("A2").CurrentRegion.Value
        For I = 2 To UBound(sArr)
            K = K + 1
            dArr(K, 1) = K
            For J = 2 To 7
                dArr(K, J) = sArr(I, J)
            Next
        Next
    End If
Next
If K Then
With Sheets("Tong hop")
    .Range("A2").CurrentRegion.Offset(1).Borders.LineStyle = 0
    .Range("A2").CurrentRegion.Offset(1).ClearContents
    .Range("A3").Resize(K, 7).Value = dArr
    .Range("A3").Resize(K, 7).Borders.LineStyle = 1
End With
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác, chúc bác 1 ngày tốt lành :D
 
Upvote 0
hpkhuong đã viết:
1. Chạy code này để tách (chạy 1 lần đầu thôi).
Mã: 
Public Sub Tach_Sheet()
Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each Ws In Worksheets
    If Ws.Name <> "Tong hop" Then Ws.Delete
Next
sArr = Range("C3", Range("C3").End(4)).Value
Set Rng = Range("A2").CurrentRegion
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 1 To UBound(sArr)
    If sArr(I, 1) <> Empty Then
    Tmp = sArr(I, 1)
        If Not Dic.exists(Tmp) Then
            Dic.Add Tmp, ""
            Rng.AutoFilter 3, Tmp
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Tmp
            Rng.SpecialCells(12).Copy
            Sheets(Tmp).Range("A2").PasteSpecial 8
            Sheets(Tmp).Range("A2").PasteSpecial xlPasteAll
        End If
    End If
    Next
Sheet1.Activate
Sheet1.ShowAllData
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

2. Code này copy vào sheet "Tong hop". Cập nhật dữ liệu ở sheet con sẽ tự động chạy về tổng hợp

Mã: 
Private Sub Worksheet_Activate()
Dim sArr, dArr(1 To 65000, 1 To 7), I As Long, J As Long, K As Long, Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
    If Ws.Name <> "Tong hop" Then
        sArr = Ws.Range("A2").CurrentRegion.Value
        For I = 2 To UBound(sArr)
            K = K + 1
            dArr(K, 1) = K
            For J = 2 To 7
                dArr(K, J) = sArr(I, J)
            Next
        Next
    End If
Next
If K Then
With Sheets("Tong hop")
    .Range("A2").CurrentRegion.Offset(1).Borders.LineStyle = 0
    .Range("A2").CurrentRegion.Offset(1).ClearContents
    .Range("A3").Resize(K, 7).Value = dArr
    .Range("A3").Resize(K, 7).Borders.LineStyle = 1
End With
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Dear bác hpkhuong,
Theo code của bác thì lúc tách file sẽ xóa toàn bộ các sheet khác, chỉ để lại sheet "tonghop", nhưng file thực tế em đang thực hiện có 1 sheet ( tạm gọi là Sheet A) không thể xóa đi được, việc này em có thể sửa code để lúc tách file sẽ không xóa sheet đó.
Nhưng một vấn đề nảy sinh khi tổng hợp dữ liệu từ các sheet con về sheet "tonghop", có thể sửa code của bác như thế nào để không cho dữ liệu từ Sheet A nhảy về sheet "tonghop' được không?
Em cảm ơn bác!
 
Upvote 0
hpkhuong đã viết:
Bạn biết sửa code -> bạn tự xử được mà.
Nếu sheet tạm của bạn ít thì bạn có thể xem câu lệnh trong code để loại trừ nó. Trường hợp sheet tạm nhiều thì:
->Vậy bạn phải có 1 danh sách tên những sheet cần tổng hợp về sheet tổng hợp. Và dùng vòng lặp duyệt danh sách này. Nếu thỏa thì lấy về tổng hợp.
Nhấp chuột vào đây để mở rộng...
Lúc tách sheet, em có sửa đoạn code như sau:
If Ws.Name <> "Tong hop" and Ws.Name <> "SheetA" Then Ws.Delete
em đã thử và thấy vẫn tách được sheet và giữ được sheetA không bi xóa.
.....
Tuy nhiên, với tư duy tương tự khi sửa code để cho dữ liệu nhảy từ các sheet con về thì file tổng hợp bị lộn xộn rất nhiều:
If Ws.Name <> "Tong hop" and Ws.Name <> "SheetA" Then
 
Upvote 0
hpkhuong đã viết:
Bạn biết sửa code -> bạn tự xử được mà.
Nếu sheet tạm của bạn ít thì bạn có thể xem câu lệnh trong code để loại trừ nó. Trường hợp sheet tạm nhiều thì:
->Vậy bạn phải có 1 danh sách tên những sheet cần tổng hợp về sheet tổng hợp. Và dùng vòng lặp duyệt danh sách này. Nếu thỏa thì lấy về tổng hợp.
Nhấp chuột vào đây để mở rộng...
Như file đính kèm em đã tách được file theo code của bác, tuy nhiên khi áp dụng code như bên dưới để cho dữ liệu từ sheet con tự tổng hợp về sheet "tonghop" thì không được:
Private Sub Worksheet_Activate()
Dim sArr, dArr(1 To 65000, 1 To 45), I As Long, J As Long, K As Long, Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
If Ws.Name <> "TH Hop dong" and Ws.Name <> "Drop" Then
sArr = Ws.Range("A3").CurrentRegion.Value
For I = 2 To UBound(sArr)
K = K + 1
dArr(K, 1) = K
For J = 2 To 45
dArr(K, J) = sArr(I, J)
Next
Next
End If
Next
If K Then
With Sheets("TH Hop dong")
.Range("A3").CurrentRegion.Offset(1).Borders.LineStyle = 0
.Range("A3").CurrentRegion.Offset(1).ClearContents
.Range("A4").Resize(K, 45).Value = dArr
.Range("A4").Resize(K, 45).Borders.LineStyle = 1
End With
End If
Application.ScreenUpdating = True
End Sub
 

File đính kèm

Upvote 0
hpkhuong đã viết:
Mã: 
Public Sub Tach_Sheet()
Dim Dic As Object, Tmp, I As Long, K As Long, sArr, Rng As Range, Ws As Worksheet
Application.ScreenUpdating = False
Application.DisplayAlerts = False
On Error Resume Next
For Each Ws In Worksheets
    If Ws.Name <> "TH Hop dong" And Ws.Name <> "Drop" Then Ws.Delete
Next
Set Rng = Sheet1.UsedRange
sArr = Rng.Value
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 4 To UBound(sArr)
    If sArr(I, 4) <> Empty Then
    Tmp = sArr(I, 4)
        If Not Dic.exists(Tmp) Then
            Dic.Add Tmp, ""
            Rng.Offset(3).AutoFilter 4, Tmp
            Sheets.Add After:=Sheets(Sheets.Count)
            Sheets(Sheets.Count).Name = Tmp
            Rng.SpecialCells(12).Copy
            Sheets(Tmp).Range("A1").PasteSpecial 8
            Sheets(Tmp).Range("A1").PasteSpecial xlPasteAll
        End If
    End If
    Next
Sheet1.Activate
Sheet1.ShowAllData
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Mã: 
Private Sub Worksheet_Activate()
Dim sArr, dArr(1 To 65000, 1 To 45), I As Long, J As Long, K As Long, Ws As Worksheet
Application.ScreenUpdating = False
For Each Ws In Worksheets
    If Ws.Name <> "TH Hop dong" And Ws.Name <> "Drop" Then
        sArr = Ws.UsedRange.Value
        For I = 4 To UBound(sArr)
        If Len(sArr(I, 4)) Then
            K = K + 1
            For J = 1 To 45
                dArr(K, J) = sArr(I, J)
            Next
        End If
        Next
    End If
Next
If K Then
With Sheets("TH Hop dong")
    .UsedRange.Offset(3).Borders.LineStyle = 0
    .UsedRange.Offset(3).ClearContents
    .Range("A4").Resize(K, 45).Value = dArr
    .Range("A4").Resize(K, 45).Borders.LineStyle = 1
End With
End If
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Em cảm ơn bác :D
 
Upvote 0
phuyen89 đã viết:
+ Mình tiến hành Xoá Sheet trước khi Tạo ra.
PHP: 
Private Sub Delete_Sheet()
    Application.DisplayAlerts = True
    Dim Wks As Worksheet
    For Each Wks In Worksheets
        If Wks.Name <> "Tonghop" Then
            Wks.Delete
        End If
    Application.DisplayAlerts = False
    Next Wks
End Sub
Nhấp chuột vào đây để mở rộng...
Bổ sung. Có thể viết thêm code kiểm tra sheet tồn tại chưa. Nếu sheet đã tồn tại rồi thì phải làm gì....
 
Upvote 0
Gakafu đã viết:
Anh ơi , hỗ trợ giúp em được không ạ ?
Nhấp chuột vào đây để mở rộng...
Góp ý cho bạn:
1/ Bạn đã đăng bài trong chủ đề tách sheet thì bạn nên đính kèm File và tiếp tục hỏi ở đây chứ không nên mở Topic mới vì có thể sẽ vi phạm nội quy.
2/ Cách hỏi của bạn trống không thế này "hỗ trợ giúp em được không ạ ?" là thiếu tôn trọng với các tành viên trên diễn đàn.
3/ Khi hỏi thì nên cụ thể việc tách sheet của bạn thì dựa vào cột nào? Của sheet nào?
 
Upvote 0
vanthinh3101 đã viết:
Tôi thấy cảnh bảo của @hpkhuong không sai đâu, bạn đang làm ngược đấy.
Bạn nên dùng sheets Tổng hợp để theo dõi mọi số liệu, sau mỗi lần thay đổi số liệu, bạn cập nhật lại vào các Sheet con là cách hay hơn.
Tôi sẽ làm qua các bước sau:
- Bước 1: Dùng lệnh Offset để tạo Name động cho vùng dữ liệu của Bảng tổng hợp
- Bước 2: Tạo 1 sheet PivotTable để tạo Pivot Table
- Bước 3: Dùng code của @kyo để bảng Pivot Table có thể tự động cập nhật khi dữ liệu nguồn thay đổi
- Bước 4: Dùng code của @be09 để tách sheets theo Pivot Table
Khi dữ liệu ở Sheet Tong hop thay đổi, bạn click lại nút Tách Sheets là các dữ liệu con sẽ thay đổi theo
Bạn xem file đính kèm nhé!
Nhấp chuột vào đây để mở rộng...
Em đang gặp phải một vấn đề kỳ lạ khi chạy thử file đính kèm ở bài viết #14. Chạy file thì không báo lỗi nhưng có lúc thì sheet được tách ra sẽ có tên là "Nguyễn Văn A", "Nguyễn Văn B", "Nguyễn Văn C" nhưng có lúc sheet tách ra lại có tên là "Detail1", "Detail2", "Detail3". Tên sheet tách ra sẽ được đổi tên theo một trong hai kiểu trên.
PHP: 
Sub DoiTen_SheetTach()
Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets
    On Error Resume Next
        If sht.Name <> "PivotTable" And sht.Name <> "Tong hop" And sht.Name <> "PivotTable" Then
            sht.Name = sht.Range("C2")
            sht.Activate
            Cells.EntireColumn.AutoFit
            Sheets("PivotTable").Select
        End If
    Next sht
End Sub
Em đang nguyên cứu để tự động đổi tên sheet từ đoạn code của bác @vanthinh3101 để áp dụng vào công việc nhưng kết quả chạy thử làm em lú lẫn luôn. Mong mọi người xem bài có thể giúp em tìm ra nguyên nhân kết quả đổi tên không thống nhất như vậy ạ.
Em xin cảm ơn.
 
Upvote 0
test1986 đã viết:
Em đang gặp phải một vấn đề kỳ lạ khi chạy thử file đính kèm ở bài viết #14. Chạy file thì không báo lỗi nhưng có lúc thì sheet được tách ra sẽ có tên là "Nguyễn Văn A", "Nguyễn Văn B", "Nguyễn Văn C" nhưng có lúc sheet tách ra lại có tên là "Detail1", "Detail2", "Detail3". Tên sheet tách ra sẽ được đổi tên theo một trong hai kiểu trên.
PHP: 
Sub DoiTen_SheetTach()
Dim sht As Worksheet

    For Each sht In ThisWorkbook.Worksheets
    On Error Resume Next
        If sht.Name <> "PivotTable" And sht.Name <> "Tong hop" And sht.Name <> "PivotTable" Then
            sht.Name = sht.Range("C2")
            sht.Activate
            Cells.EntireColumn.AutoFit
            Sheets("PivotTable").Select
        End If
    Next sht
End Sub
Em đang nguyên cứu để tự động đổi tên sheet từ đoạn code của bác @vanthinh3101 để áp dụng vào công việc nhưng kết quả chạy thử làm em lú lẫn luôn. Mong mọi người xem bài có thể giúp em tìm ra nguyên nhân kết quả đổi tên không thống nhất như vậy ạ.
Em xin cảm ơn.
Nhấp chuột vào đây để mở rộng...
Vụ đổi tên sheet thì bạn nên hiểu đoạn này "sht.Name = sht.Range("C2")"
Tên sheet sẽ được đặt theo Range("C2") tại sheet cần đổi.
 
Upvote 0
hvnhpro đã viết:
Vụ đổi tên sheet thì bạn nên hiểu đoạn này "sht.Name = sht.Range("C2")"
Tên sheet sẽ được đặt theo Range("C2") tại sheet cần đổi.
Nhấp chuột vào đây để mở rộng...
Dạ đúng rồi ạ, nên nếu đúng theo lý thuyết thì sẽ phải đổi tên sheet thống nhất là "Nguyễn Văn A", "Nguyễn Văn B", Nguyễn Văn C" là kết quả đúng. Nhưng không hiểu vì sao lại có trường hợp đổi tên thứ 2 là sheet thay vì đổi tên như trên thì lại đổi tên thành "Detail1", "Detail2", "detail3" mà trong table hàng cột đều không có giá trị"Detail1", "Detail2", "Detail3" để mà gán tên cho sheet, giống như là trên trời rơi xuống vậy á anh.
 
Upvote 0
test1986 đã viết:
Dạ đúng rồi ạ, nên nếu đúng theo lý thuyết thì sẽ phải đổi tên sheet thống nhất là "Nguyễn Văn A", "Nguyễn Văn B", Nguyễn Văn C" là kết quả đúng. Nhưng không hiểu vì sao lại có trường hợp đổi tên thứ 2 là sheet thay vì đổi tên như trên thì lại đổi tên thành "Detail1", "Detail2", "detail3" mà trong table hàng cột đều không có giá trị"Detail1", "Detail2", "Detail3" để mà gán tên cho sheet, giống như là trên trời rơi xuống vậy á anh.
Nhấp chuột vào đây để mở rộng...
thế bạn phải chạy debug mới biết được code lấy dữ liệu như thế nào.
Không có file mà chỉ nhìn code, mình đoán mò được thế thôi.
 
Upvote 0
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

C
Fix lỗi Application.InputBox Type:=8 (1 người xem)
    • Cười
Trả lời
7
Đọc
129
SA_DQ
SA_DQ
A
  • Question Question
Sửa code VBA nhập liệu userform (1 người xem)
Trả lời
25
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba (3 người xem)
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
556
Đọc
72K
sát thủ uyên ương
S
Emyeuexcel
Tham chiếu về 1 ô-lấy ra và lọc dữ liệu
Trả lời
5
Đọc
98
Emyeuexcel
Emyeuexcel
L
Hỏi lỗi excel bị tràn trang khi in
Trả lời
3
Đọc
77
Hoàng Tuấn 868
H
E
  • Question Question
VBA tự động thay đổi tham chiếu vùng (range và cell) khi insert dòng cột trong sheet tính toán
    • Cười
Trả lời
5
Đọc
127
eagle12
E
D
Tổng hợp dữ liệu từ các sheet sang sheet tổng
Trả lời
3
Đọc
150
dohungmo
D
T
font chu trong excel
Trả lời
2
Đọc
76
Hoàng Tuấn 868
H
khuong182018
  • Question Question
Nhờ anh chị sửa lỗi setfocus ở textbox (1 người xem)
Trả lời
9
Đọc
167
khuong182018
khuong182018
N
File chia băng tự động từ cuộn mẹ theo khổ băng và khối lượng băng cho trước
Trả lời
0
Đọc
45
nguyenanhtruong2409
N
SA_DQ
Copilot bình luận về một ván cờ vua
Trả lời
0
Đọc
77
SA_DQ
SA_DQ
T
Xin giúp đỡ lọc dữ liệu (2 người xem)
    • Cười
Trả lời
4
Đọc
118
pycckuu410
pycckuu410
Nguyễn Duy Tuân
[New] BSAC v3.0 bộ công cụ lập trình phần mềm chuyên nghiệp trong VBA
    • Thích
Trả lời
13
Đọc
4K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Code Sổ Chi Tiết Tài Khoản
Trả lời
8
Đọc
333
hieuvietmy2020
H
befaint
Chia sẻ tâm tư, xả nỗi lòng (5 người xem)
    • Thích
6 7 8
Trả lời
778
Đọc
75K
SA_DQ
SA_DQ
H
Chia sẻ file in Phiếu điều tra PCGD
    • Thích
    • Yêu thích
    • Cảm ơn
Trả lời
12
Đọc
448
HUONGHCKT
H
V
Hỏi công thức để làm khối lượng trong xây dựng. Xin cảm ơn
Trả lời
11
Đọc
525
phanphu_91
P
Linhnv0001
Hỏi - Cách kiểm tra laptop là hàng lắp ráp hay không (1 người xem)
Trả lời
3
Đọc
276
Lê Duy Thương
Lê Duy Thương
K
Nhờ anh chị làm công thức lọc dữ kiện ngày từ bảng 1 sang rút gọn ngày ở bảng 2.
Trả lời
2
Đọc
191
Lê Duy Thương
Lê Duy Thương
L
[Mẹo] Không chọn Add-in vẫn có thể sử dụng được chức năng của Add-in, giảm tốc độ loading của Excel.
    • Thích
Trả lời
2
Đọc
500
HeSanbi
HeSanbi
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