Tổng hợp dữ liệu tự động theo tháng (1 người xem)

[NGOCTOAN]

K/gửi : Các Anh Chị GPE
Nhờ các Anh Chị chỉ giúp cách tổng hợp thống kê dữ liệu theo file kèm ạ.
Xin cảm ơn./.
Ngoctoan.

 

[bebanhbeo]

K/gửi : Các Anh Chị GPE
Nhờ các Anh Chị chỉ giúp cách tổng hợp thống kê dữ liệu theo file kèm ạ.
Xin cảm ơn./.
Ngoctoan.

Bạn xem thử nha

 

[Anh DW]

K/gửi : Các Anh Chị GPE
Nhờ các Anh Chị chỉ giúp cách tổng hợp thống kê dữ liệu theo file kèm ạ.
Xin cảm ơn./.
Ngoctoan.

Cột tiền ko biết bạn tính sao ? nên minh insert ra 1 cột nữa . bạn xem file đính kèm nhé

 

[NGOCTOAN]

Cột tiền ko biết bạn tính sao ? nên minh insert ra 1 cột nữa . bạn xem file đính kèm nhé

Cảm các Anh Chị, nhưng nhu cầu thống kê tính phần chỉ tiêu bao gồm lấy tên các các cột vídụ: LAI - tên các nhà thầu nước ngoài ( nhưng chỉ tiêu cột LAI,QL, BL,...) cái nào có tiền mới lấy dữ liệu sau đó sắp xếp thứ tự. trên đây là ví dụ minh họa ít phát sinh trong1 tháng, 1 tháng có rất nhiều chỉ tiêu và nhà thầu nên

 

[NGOCTOAN]

Cảm các Anh Chị, nhưng nhu cầu thống kê tính phần chỉ tiêu bao gồm lấy tên các các cột vídụ: LAI - tên các nhà thầu nước ngoài ( nhưng chỉ tiêu cột LAI,QL, BL,...) cái nào có tiền mới lấy dữ liệu sau đó sắp xếp thứ tự. trên đây là ví dụ minh họa ít phát sinh trong1 tháng, 1 tháng có rất nhiều chỉ tiêu và nhà thầu nên

Em lấy ví dụ tháng 8 thì cần 4 dòng như file đây cho các anh chị dễ hình dùng

Các Anh Chị chú ý các chữ màu đỏ ạ. Xin cảm ơn

 

[Phuocam]

Thử code này trong sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$20" Then Call TongHop
End Sub
'...................
Private Sub TongHop()
Dim lr, i, j, k As Long
Dim sArr(), dArr()
lr = Range("A" & Rows.Count).End(xlUp).Row
sArr = Range("A4:L" & lr).Value
lr = UBound(sArr, 1)
ReDim dArr(1 To lr, 1 To 3)
    For i = 2 To lr
        If sArr(i, 1) = Range("C20").Value Then
            For j = 4 To 12
                If sArr(i, j) <> "" Then
                    k = k + 1
                    dArr(k, 1) = sArr(1, j) & "-" & sArr(i, 2)
                    dArr(k, 2) = sArr(i, 3)
                    dArr(k, 3) = sArr(i, j)
                End If
            Next j
        End If
    Next i
    Range("B22:D1000").ClearContents
    If k > 0 Then Range("B22").Resize(k, 3) = dArr
End Sub

 

[NGOCTOAN]

Thử code này trong sheet1:

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$C$20" Then Call TongHop
End Sub
'...................
Private Sub TongHop()
Dim lr, i, j, k As Long
Dim sArr(), dArr()
lr = Range("A" & Rows.Count).End(xlUp).Row
sArr = Range("A4:L" & lr).Value
lr = UBound(sArr, 1)
ReDim dArr(1 To lr, 1 To 3)
    For i = 2 To lr
        If sArr(i, 1) = Range("C20").Value Then
            For j = 4 To 12
                If sArr(i, j) <> "" Then
                    k = k + 1
                    dArr(k, 1) = sArr(1, j) & "-" & sArr(i, 2)
                    dArr(k, 2) = sArr(i, 3)
                    dArr(k, 3) = sArr(i, j)
                End If
            Next j
        End If
    Next i
    Range("B22:D1000").ClearContents
    If k > 0 Then Range("B22").Resize(k, 3) = dArr
End Sub

Đúng rồi bạn Phuocam, cảm ơn nhiều ạ
Ngoctoan,