Tìm dữ liệu và tách thành nhiều cột (1 người xem)

[lmtuyen]

Chào Anh/Chị
Mình có 1 file lấy tạo BOM lấy dữ lệu từ SAP ( sheet "DATA"), mình cần sắp xếp lại dữ liệu để chạy file kế hoạch tính nguyên vật liệu cần cho sản xuất). Theo yêu cầu từ trong sheet "RES", mình làm bằng tay lâu quá. Anh/Chị hướng dẫn giúp.

Chân Thành Cảm ơn!

 

[doveandrose]

nếu có hơn 4 Component thì bạn phải ráng chịu nhé

Public Sub hello()
Dim rsArr As Variant, arr As Variant, Dic As Object, r As Long, k As Long, tempItem As Variant
arr = Sheet1.Range("A3:G" & Sheet1.Range("A1000000").End(xlUp).Row).Value
ReDim rsArr(1 To UBound(arr), 1 To 12)
Set Dic = CreateObject("Scripting.Dictionary")
For r = 1 To UBound(arr) Step 1
    If Not Dic.exists(arr(r, 1)) Then
        k = k + 1
        Dic.Add arr(r, 1), Array(k, 3, 7)
        rsArr(k, 1) = arr(r, 1)
        rsArr(k, 2) = arr(r, 2)
    Else
        tempItem = Dic(arr(r, 1))
        tempItem(1) = tempItem(1) + 1
        tempItem(2) = tempItem(2) + 1
        Dic(arr(r, 1)) = tempItem
    End If
    rsArr(Dic(arr(r, 1))(0), Dic(arr(r, 1))(1)) = arr(r, 3)
    rsArr(Dic(arr(r, 1))(0), Dic(arr(r, 1))(2)) = arr(r, 5)
    rsArr(Dic(arr(r, 1))(0), 11) = arr(r, 6)
    rsArr(Dic(arr(r, 1))(0), 12) = arr(r, 7)
Next
Sheet2.Range("A3").Resize(k + 10000, 12).ClearContents
Sheet2.Range("A3").Resize(k, 12).Value = rsArr
End Sub

 

[Ba Tê]

Chào Anh/Chị
Mình có 1 file lấy tạo BOM lấy dữ lệu từ SAP ( sheet "DATA"), mình cần sắp xếp lại dữ liệu để chạy file kế hoạch tính nguyên vật liệu cần cho sản xuất). Theo yêu cầu từ trong sheet "RES", mình làm bằng tay lâu quá. Anh/Chị hướng dẫn giúp.

Chân Thành Cảm ơn!

Chép Macro sự kiện này vào sheet RES thử xem nhé.
Có thể nhập 1 ô hoặc Copy nhiều ô paste vào cột A sheet RES.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim sArr(), dArr(), I As Long, J As Long, CoL As Long, Cll As Range, Tem As String, K As Long
If Not Intersect(Target, [A3:A1000]) Is Nothing Then
    ReDim dArr(1 To Target.Rows.Count, 1 To 11)
    With Sheets("DATA")
        sArr = .Range(.[A3], .[A3].End(xlDown)).Resize(, 7).Value
    End With
    For Each Cll In Target
        Tem = Cll.Value
        K = K + 1: CoL = 1
        For I = 1 To UBound(sArr, 1)
        If sArr(I, 1) = Tem Then
            dArr(K, 1) = sArr(I, 2)
            CoL = CoL + 1
            dArr(K, CoL) = sArr(I, 3)
            dArr(K, CoL + 4) = sArr(I, 5)
            dArr(K, 10) = sArr(I, 6)
            dArr(K, 11) = sArr(I, 7)
        End If
        Next I
    Next Cll
    Target.Offset(, 1).Resize(K, 11) = dArr
End If
End Sub

 

[be_09]

Nếu dữ liệu như phần tô màu vàng thì dùng PivotTable đi cho nhanh gọn.

 

[lmtuyen]

Chân Thành Cảm ơn Anh đã hướng dẫn code, chạy rất đúng ý.