Sắp xếp dữ liệu để Pivot table (1 người xem)

[russ]

Mong AC trên diễn đàn giúp em sắp xếp lại dữ liệu để em Pivot table.
Chưa biết, nên em làm thủ công, mất thời gian quá.
Em có gửi kèm file mẫu.
Em xin cảm ơn.

 

[ndu96081631]

Mong AC trên diễn đàn giúp em sắp xếp lại dữ liệu để em Pivot table.
Chưa biết, nên em làm thủ công, mất thời gian quá.
Em có gửi kèm file mẫu.
Em xin cảm ơn.

Tôi có thể làm bài này cho bạn bằng code VBA --> Nếu bạn đồng ý thì ta tiếp tục

 

[russ]

Tôi có thể làm bài này cho bạn bằng code VBA --> Nếu bạn đồng ý thì ta tiếp tục

Vâng, mong thầy giúp em.

 

[ndu96081631]

Vâng, mong thầy giúp em.

Dùng code này:

Sub Table2DB(ByVal SrcRng As Range, ByVal Target As Range)
  Dim sArray, lR As Long, lC As Long, n As Long, Arr()
  On Error Resume Next
  sArray = SrcRng.Value
  ReDim Arr(1 To (UBound(sArray, 1) - 1) * (UBound(sArray, 2) - 1), 1 To 3)
  For lC = 2 To UBound(sArray, 2)
    If CStr(sArray(1, lC)) <> "" Then
      For lR = 2 To UBound(sArray, 1)
        If CStr(sArray(lR, 1)) <> "" Then
          If CStr(sArray(lR, lC)) <> "" Then
            n = n + 1
            Arr(n, 1) = sArray(1, lC)
            Arr(n, 2) = sArray(lR, 1)
            Arr(n, 3) = sArray(lR, lC)
          End If
        End If
      Next
    End If
  Next
  If n Then Target.Resize(n, 3).Value = Arr
End Sub

Sub Main()
  Dim SrcRng As Range, Target As Range
  Set SrcRng = Range("A3:J1000")
  Set Target = Range("H4")
  Range("H:J").ClearContents
  Table2DB SrcRng, Target
End Sub

Mở file đính kèm, bấm nút mũi tên sẽ ra kết quả