Nhờ các anh chị tạo giúp em Macro để tổng hợp dữ liệu từ Sheet1 sang Sheet2 (1 người xem)

[baquang1984]

Em chưa biết nhiều về Lập trình VBA trong Excel nên nhờ anh, chị trên diễn đàn giúp đỡ
Em có một bảng dữ liệu nhập vào ở Sheet1 và tạo một Button tổng hợp dữ liệu ở Sheet1 và khi Click chuột vào Button thì dữ liệu được chuyển sang Sheet2 như mô tả trong file đính kem
Rất mong được mọi người giúp đỡ để có thể áp dụng vào công việc của mình
Cảm ơn mọi người rất nhiều!
Đây là đường Link tải file http://www.fshare.vn/file/T9AYQMRG4T/ mọi người thông cảm em không update được file lên diễn đàn

 

[Ba Tê]

Em chưa biết nhiều về Lập trình VBA trong Excel nên nhờ anh, chị trên diễn đàn giúp đỡ
Em có một bảng dữ liệu nhập vào ở Sheet1 và tạo một Button tổng hợp dữ liệu ở Sheet1 và khi Click chuột vào Button thì dữ liệu được chuyển sang Sheet2 như mô tả trong file đính kem
Rất mong được mọi người giúp đỡ để có thể áp dụng vào công việc của mình
Cảm ơn mọi người rất nhiều!
Đây là đường Link tải file http://www.fshare.vn/file/T9AYQMRG4T/ mọi người thông cảm em không update được file lên diễn đàn

Sheet1 tên Data, Sheet2 tên GPE.

 

[baquang1984]

Cảm ơn bác Ba Tê đã nhiệt tích giúp đỡ chúc bác sức khỏe nhé
Tuy nhiên em muốn bác có thể bớt chút thời gian để giải thích dùm em Code mà bác viết được không ạ

Public Sub GPE()
Dim sArr(), dArr(), N As Long, I As Long, J As Long, K As Long, CR As String, NDT As String, DK As String
With Sheets("Data")
    DK = .[A1].Value
    sArr = .[A1].CurrentRegion.Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 1, 1 To 8)
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) = DK Then
            CR = sArr(I + 1, 2)
            NDT = sArr(I + 2, 2)
            I = I + 3
        Else
            K = K + 1
            dArr(K, 1) = CR
            dArr(K, 2) = NDT
            For J = 1 To 6
                dArr(K, J + 2) = sArr(I, J)
            Next J
        End If
    Next I
With Sheets("GPE")
    .[A2:H65536].ClearContents
    .[A2].Resize(K, 8).Value = dArr
End With
MsgBox "XONG!", , "GIAI PHAP EXCEL"
End Sub

Sheet1 tên Data, Sheet2 tên GPE.

 

[Ba Tê]

Cảm ơn bác Ba Tê đã nhiệt tích giúp đỡ chúc bác sức khỏe nhé
Tuy nhiên em muốn bác có thể bớt chút thời gian để giải thích dùm em Code mà bác viết được không ạ

Public Sub GPE()
Dim sArr(), dArr(), N As Long, I As Long, J As Long, K As Long, CR As String, NDT As String, DK As String
With Sheets("Data")
    DK = .[A1].Value
    sArr = .[A1].CurrentRegion.Value
End With
ReDim dArr(1 To UBound(sArr, 1) * 1, 1 To 8)
    For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) = DK Then
            CR = sArr(I + 1, 2)
            NDT = sArr(I + 2, 2)
            I = I + 3
        Else
            K = K + 1
            dArr(K, 1) = CR
            dArr(K, 2) = NDT
            For J = 1 To 6
                dArr(K, J + 2) = sArr(I, J)
            Next J
        End If
    Next I
With Sheets("GPE")
    .[A2:H65536].ClearContents
    .[A2].Resize(K, 8).Value = dArr
End With
MsgBox "XONG!", , "GIAI PHAP EXCEL"
End Sub

Tui cũng làm "mò" theo cấu trúc dữ liệu, biểu giải thích chắc hổng được rồi.
Chỉ nhờ sửa lại chỗ này một chút.
Từ:

ReDim dArr(1 To UBound(sArr, 1) * 1, 1 To 8)

Thành

ReDim dArr(1 To UBound(sArr, 1), 1 To 8)

Bỏ cái *1 dzô dziêng", hổng hiểu do "quíu tay" hay sao mà nhìn "lãng nhách".

 

[Quang_Hải]

Tui cũng làm "mò" theo cấu trúc dữ liệu, biểu giải thích chắc hổng được rồi.

Phải công nhận code này của anh Batê hay thiệt. Code sẽ hay hơn xíu nữa nếu thêm cái xét tại cột B mà trống thì bỏ qua dòng trống này.

 

[Ba Tê]

Phải công nhận code này của anh Batê hay thiệt. Code sẽ hay hơn xíu nữa nếu thêm cái xét tại cột B mà trống thì bỏ qua dòng trống này.

Thì đó đó!
Làm "mò" theo cấu trúc dữ liệu nhìn thấy thôi, nếu dữ liệu có các dòng trống thì sẽ "chú ý" thêm.
Có thấy mấy cái dấu ......... nhưng lại hiểu đó là "còn có nhiều dòng dữ liệu nữa".
Híc!