Lấy dữ liệu báo cáo từ Sheet nguồn

Liên hệ QC

mitdacdtd

Thành viên hoạt động
Tham gia
14/10/17
Bài viết
150
Được thích
23
Giới tính
Nam
Chào anh em diễn đàn.
Mình lại nhờ anh em giúp mình một file dữ liệu với nội dung sau: tự chuyển dữ liệu bên sheet data sang sheet Report. Anh em giúp mình nhé.
Cảm ơn mọi người nhiều.
(Rất xin lỗi vì làm phiền mọi người vì mình đang rất dốt nên sẽ hỏi mọi người rất nhiều)
 

File đính kèm

  • Tiến độ.xls
    88.5 KB · Đọc: 6
Mở pass VBA đi bạn.
 
191181 bạn ơi. Mình đính chính lại file này
Kết quả của dòng 3 lấy thế nào mà có các ngày 1,9,10 trong khi Data chỉ phát sinh từ ngày 22/3 ?
PHP:
Public Sub sGpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, D As Long, Txt As String
sArr = Sheets("Data").Range("A2", Sheets("Data").Range("A2").End(xlDown)).Resize(, 10).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 36)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
       Txt = sArr(I, 2) & "#" & sArr(I, 3)
       D = 5 + Split(sArr(I, 1), "/")(0)
       If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 3)
            dArr(K, 4) = 1
            dArr(K, 5) = sArr(I, 4)
            dArr(K, D) = sArr(I, 5)
        Else
            Rws = .Item(Txt)
            dArr(Rws, 4) = dArr(Rws, 4) + 1
            dArr(Rws, D) = sArr(I, 5)
        End If
    Next I
End With
Sheets("Report").Range("A3").Resize(1000, 36) = dArr
Sheets("Report").Range("A3").Resize(K, 36) = dArr
End Sub
 
Lấy code bài #4.
Tham khảo file đính kèm, cũng sử dụng Dictionary.
 

File đính kèm

  • Tiến độ (1).xls
    114.5 KB · Đọc: 7
Kết quả của dòng 3 lấy thế nào mà có các ngày 1,9,10 trong khi Data chỉ phát sinh từ ngày 22/3 ?
PHP:
Public Sub sGpe()
Dim sArr(), dArr(), I As Long, K As Long, R As Long, Rws As Long, D As Long, Txt As String
sArr = Sheets("Data").Range("A2", Sheets("Data").Range("A2").End(xlDown)).Resize(, 10).Value
R = UBound(sArr)
ReDim dArr(1 To R, 1 To 36)
With CreateObject("Scripting.Dictionary")
    For I = 1 To R
       Txt = sArr(I, 2) & "#" & sArr(I, 3)
       D = 5 + Split(sArr(I, 1), "/")(0)
       If Not .Exists(Txt) Then
            K = K + 1
            .Item(Txt) = K
            dArr(K, 1) = K
            dArr(K, 2) = sArr(I, 2)
            dArr(K, 3) = sArr(I, 3)
            dArr(K, 4) = 1
            dArr(K, 5) = sArr(I, 4)
            dArr(K, D) = sArr(I, 5)
        Else
            Rws = .Item(Txt)
            dArr(Rws, 4) = dArr(Rws, 4) + 1
            dArr(Rws, D) = sArr(I, 5)
        End If
    Next I
End With
Sheets("Report").Range("A3").Resize(1000, 36) = dArr
Sheets("Report").Range("A3").Resize(K, 36) = dArr
End Sub
Hiện em đang dùng công thức để lọc duy nhất và hàm sumproduct nhưng rất nặng bác ạ
 

File đính kèm

  • Tiến độ.xls
    182 KB · Đọc: 1
Web KT
Back
Top Bottom