Tổng hợp dữ liệu từ nhiều sheet về sheet Data

Tom.lê · 23/3/20

Chào tất cả các bác.
Em có đoạn Code tổng hợp dữ liệu của sheet.
Nhưng nó chỉ tổng hợp đc 1 sheet 04 thôi. Giờ em muốn nó tổng hợp tất cả các sheet còn lại vào sheet Data . mong các bác giúp đỡ ạ.

Mã:

Option Explicit



Public Sub s_Gpe()

Application.ScreenUpdating = False

Dim sArr(), dArr(), C As Long, I As Long, J As Long, R As Long, CoL As Long

With Sheets("04")

    CoL = .Range("XFD2").End(xlToLeft).Column

    sArr = .Range("E2", .Range("E2").End(xlDown)).Resize(, CoL).Value2

    R = UBound(sArr)

End With

With Sheets("Data")

    For J = 1 To CoL

        If sArr(1, J) <> Empty Then

            C = sArr(1, J)

            ReDim dArr(1 To R, 1 To 1)

            For I = 2 To R

                dArr(I - 1, 1) = sArr(I, J)

            Next I

        End If

        .Cells(3, C).Resize(R) = dArr

    Next J

End With

End Sub

tuhocvba · 23/3/20

1. Tôi đã sửa lại bài viết cho bạn. Bạn lưu ý, Code phải để trong
[Code ]...[/ Code]
Bạn đọc mục 4 ở đây:

Bạn cần đăng nhập để thấy link

2. Bài viết của bạn để tiêu đề chưa phù hợp. Chủ đề của bạn có gì đặc biệt?
Nếu 1000 người khác lên đây hỏi và đều ghi là "Sửa theo yêu cầu" thì sẽ thành cái gì?

Deleted member 208 · 23/3/20

1. Bạn nên sử dụng hình ảnh để thuyết minh cho người khác biết bạn muốn tổng hợp như thế nào, copy cột nào vào cột nào.
Chứ đọc code để hiểu thì sẽ khó khăn cho mọi người và cũng mất thời gian. Bạn có nghĩ thế không? Việc đó có khó khăn gì với bạn à?

2. Code của bạn, nhìn tiêu đề thì có vẻ ở bên GPE đã có ai đó giúp bạn, sao bạn không tiếp tục nhờ người ta? Họ không muốn giúp bạn nữa à?

3. Tôi chỉ nêu ý tưởng bộ khung cho bạn, còn nội dung bên trong bạn tổng hợp như nào thì tự sửa, vì bài viết của bạn cũng không thuyết minh điều này. Cụ thể các dòng code 22-44, bạn phải tự sửa lại, vì tôi không biết cấu trúc sheet data của bạn như thế nào, tổng hợp ra sao. File demo không thấy bạn đưa lên.

Mã:

Public Sub s_Gpe()

Application.ScreenUpdating = False

Dim sArr(), dArr(), C As Long, I As Long, J As Long, R As Long, CoL As Long
Dim k   As Integer


For k = 1 To ThisWorkbook.Sheets.Count

    If ThisWorkbook.Sheets(k).Name <> "Data" Then
            With ThisWorkbook.Sheets(k)
            
                CoL = .Range("XFD2").End(xlToLeft).Column
            
                sArr = .Range("E2", .Range("E2").End(xlDown)).Resize(, CoL).Value2
            
                R = UBound(sArr)
            
            End With
            
            With Sheets("Data")
            
                For J = 1 To CoL
            
                    If sArr(1, J) <> Empty Then
            
                        C = sArr(1, J)
            
                        ReDim dArr(1 To R, 1 To 1)
            
                        For I = 2 To R
            
                            dArr(I - 1, 1) = sArr(I, J)
            
                        Next I
            
                    End If
            
                    .Cells(3, C).Resize(R) = dArr
            
                Next J
            
            End With
    End If
Nextk

End Sub

vothanhthu · 23/3/20

@Tom.lê Các bạn đi nhờ vả riết quen hay sao ấy.Code không file minh họa, hình cũng không thấy đâu?. Sao bạn không đầu tư vào một bài viết giúp đỡ nhỉ?, có hại gì sao ?

Tên sub là s_gpe, khả năng cao là bạn nhờ bên GPE giúp đỡ trước rồi, sau đó vì lý do gì đó mà bạn mang sang đây. Có nghĩa là nhờ xong GPE, họ không giúp nữa giờ sang nhờ tuhocvba.

Đoạn code của bạn ở dòng số 11 đến 19 là đang xác nhận giá trị của biến, bạn chỉ cần sửa tên sheet 04 thành một biến nào đó rồi cho nó một cái vòng lặp for qua toàn bộ sheet là xong. Kiến thức này trên diễn đàn là cực kì nhiều. Đây là kiến thức cơ bản trên VBA, và Thứ mong bạn nên tự làm để có thể phát triển bản thân, nhờ người khác sao không nhờ vào chính mình..!

tuhocvba · 23/3/20

Nhiều khi mắng xong rồi lại thấy rất thương. Vì đất nước mình điều kiện học hành không đồng đều. Có được việc làm đã là tốt rồi, nói gì tới môi trường nơi làm việc. Cho nên khó có thể đòi hỏi mọi người chuyên nghiệp được ngay.
Đúng là nếu không biết VBA nhưng trình bày tỉ mỉ cẩn thận, thì người khác mới giúp được. Không sử dụng hình ảnh gì cả nên thành ra rất ngại đọc.

Đáng ra tuhocvba.net nên ra đời sớm hơn. Cái nông trại GPE làm hư hết cả mọi người.

maiban2068 · 23/3/20

Quả nhiên không đưa file demo lên thì chịu chả hiểu bạn định làm cái gì.
Khi đưa bài lên cũng không minh họa bằng hình ảnh cho dễ hiểu.
Bạn là thành viên GPE cho nên tôi hoàn toàn hiểu được. Hi vọng tham gia tuhocvba.net thì sẽ trưởng thành lên. Code đây, bạn kiểm tra lại nhé.

Mã:

Public Sub tuhocvba()

Application.ScreenUpdating = False

Dim sArr(), dArr(), C As Long, I As Long, J As Long, R As Long, CoL As Long, vt As Long
Dim k   As Integer

vt = 3
For k = 1 To ThisWorkbook.Sheets.Count

    If ThisWorkbook.Sheets(k).Name <> "Data" Then
            With ThisWorkbook.Sheets(k)
            
                CoL = .Range("XFD2").End(xlToLeft).Column
            
                sArr = .Range("E2", .Range("E2").End(xlDown)).Resize(, CoL).Value2
            
                R = UBound(sArr)
            
            End With
            
            With Sheets("Data")
            
                For J = 1 To CoL
            
                    If sArr(1, J) <> Empty Then
            
                        C = sArr(1, J)
            
                        ReDim dArr(1 To R, 1 To 1)
            
                        For I = 2 To R
            
                            dArr(I - 1, 1) = sArr(I, J)
            
                        Next I
            
                    End If
            
                    .Cells(vt, C).Resize(R) = dArr
                    
                Next J
            
            End With
            vt = vt + (R - 1)
    End If
    
Next k
Application.ScreenUpdating = True
End Sub

Tom.lê · 23/3/20

maiban2068 nói:
Quả nhiên không đưa file demo lên thì chịu chả hiểu bạn định làm cái gì.

Dạ! em cám ơn anh/chị.
Em vừa thử code thì thấy ổn, em sẽ kiểm tra thêm để xem có lỗi ko ạ.
Em sẽ chú ý và học hỏi trên này nhiều hơn. để hoàn thiện kỹ năng của mình hơn/ Cám ơn anh chị rất nhiều.
============================================
Admin tuhocvba:
Bài của bạn có thể trình bày lại cho dễ hiểu hơn như sau:

1. Mục đích:
Tổng hợp dữ liệu các sheet vào sheet Data. Số lượng sheet của file có thể biến thiên không biết trước. Tuy nhiên luôn có sheet Data.

Bạn cần đăng nhập để thấy hình ảnh

2. Logic Tổng hợp dữ liệu:
Cấu trúc sheet Data:
Trên sheet Data có đánh dấu mã cột.

Bạn cần đăng nhập để thấy hình ảnh

Trên các sheet khác, ví dụ sheet 04 cũng có đánh dấu mã cột.

Bạn cần đăng nhập để thấy hình ảnh

Mục đích: Copy dữ liệu của các cột có mã tương ứng vào trong sheet Data.

Bạn cần đăng nhập để thấy hình ảnh

3. File demo:

Bạn cần đăng nhập để thấy link

4. Tham khảo: Hiện nay code này mới chỉ copy được dữ liệu từ sheet 04 vào sheet Data. Mong muốn cải thiện, tổng hợp từ nhiều sheet vào sheet Data.

Mã:

Option Explicit



Public Sub s_Gpe()

Application.ScreenUpdating = False

Dim sArr(), dArr(), C As Long, I As Long, J As Long, R As Long, CoL As Long

With Sheets("04")

    CoL = .Range("XFD2").End(xlToLeft).Column

    sArr = .Range("E2", .Range("E2").End(xlDown)).Resize(, CoL).Value2

    R = UBound(sArr)

End With

With Sheets("Data")

    For J = 1 To CoL

        If sArr(1, J) <> Empty Then

            C = sArr(1, J)

            ReDim dArr(1 To R, 1 To 1)

            For I = 2 To R

                dArr(I - 1, 1) = sArr(I, J)

            Next I

        End If

        .Cells(3, C).Resize(R) = dArr

    Next J

End With

End Sub

Có rất nhiều cách để diễn đạt, bạn tham khảo. Tóm lại, bạn không thể đưa một bài viết như lúc đầu bạn viết, không ai muốn đọc và để hiểu yêu cầu của bạn sẽ làm người khác mất thời gian, và tôi muốn bạn không gây phiền hà cho người khác như vậy. Vì vậy lần sau hãy chú ý suy nghĩ trình bày dễ hiểu hơn.

tuhocvba · 23/3/20

Tôi đã diễn đạt lại yêu cầu cho dễ hiểu, bạn tham khảo

Bạn cần đăng nhập để thấy link

.
Mặc dù topic đã được giải quyết xong, nhưng bạn lưu ý để cải thiện trong các lần sau khi thực hiện hỏi-đáp.
Ngoài ra, bạn quote khá nhiều bài của các thành viên, gây rối topic rất nhiều.

Bạn muốn nhắc ai thì sử dụng cấu trúc @tên_nick . Để post ảnh lên diễn đàn thì tham khảo topic sau:

Bạn cần đăng nhập để thấy link

Tom.lê · 24/3/20

@tuhocvba
Thực sự thì cách suy nghĩ và cách diễn đạt của em kém.
Cách diễn đạt của admin rất dễ hiểu. em sẽ áp dụng vào lần sau.

Cám ơn admin rất là nhiều.

giaiphapvba · 24/3/20

Điều đầu tiên chúng tôi muốn các bạn cải thiện khả năng truyền đạt dễ hiểu trước khi nói tới VBA. Khả năng truyền đạt dễ hiểu chính là tác phong làm việc chuyên nghiệp mà chúng tôi muốn các bạn có được khi tham gia diễn đàn.
Truyền đạt dễ hiểu không chỉ trên diễn đàn, nó có ích trong công việc và cuộc sống của các bạn. Hãy trình bày để cho bất cứ ai (người ngu nhất cũng) hiểu được.
Topic này tôi nhận thức rằng đã được giải quyết xong, do đó khóa ở đây.

Tổng hợp dữ liệu từ nhiều sheet về sheet Data

Tom.lê

Yêu THVBA

tuhocvba

Administrator

Deleted member 208

Guest

vothanhthu

Guest

tuhocvba

Administrator

maiban2068

Guest

Tom.lê

Yêu THVBA

tuhocvba

Administrator

Tom.lê

Yêu THVBA

giaiphapvba

Administrator