Tổng hợp công nợ theo điều kiện

satthuvae · 20/1/16

Em Chào mọi người
Em có sheet tổng hợp công nợ, do sheet tổng hợp này của em luôn luôn thay đổi về mặt số liệu. Do đó khi mà mỗi lần thay đổi số liệu em ngồi nhặt bằng tay một báo cáo chi tiết theo điều kiện đã cho sẵn.
Mọi người xem có thể giúp em tạo maro tự động cho báo cáo này giúp em.
Em gửi File đính kèm
Em xin cám ơn ạ!.

hophoang · 20/1/16

satthuvae đã viết:
Em Chào mọi người
Em có sheet tổng hợp công nợ, do sheet tổng hợp này của em luôn luôn thay đổi về mặt số liệu. Do đó khi mà mỗi lần thay đổi số liệu em ngồi nhặt bằng tay một báo cáo chi tiết theo điều kiện đã cho sẵn.
Mọi người xem có thể giúp em tạo maro tự động cho báo cáo này giúp em.
Em gửi File đính kèm
Em xin cám ơn ạ!.

xEM THỬ ĐÚNG KHÔNG NHA BẠN

satthuvae · 20/1/16

hophoang đã viết:
xEM THỬ ĐÚNG KHÔNG NHA BẠN

Cám ơn Bạn nhiều
Mình nhập ô B5 là 131 hoặc 331 kết quá không giống với ví dụ bạn ah. Bạn kiểm tra lại giúp mình với.

giangleloi · 20/1/16

satthuvae đã viết:
Em Chào mọi người
Em có sheet tổng hợp công nợ, do sheet tổng hợp này của em luôn luôn thay đổi về mặt số liệu. Do đó khi mà mỗi lần thay đổi số liệu em ngồi nhặt bằng tay một báo cáo chi tiết theo điều kiện đã cho sẵn.
Mọi người xem có thể giúp em tạo maro tự động cho báo cáo này giúp em.
Em gửi File đính kèm
Em xin cám ơn ạ!.

Xem file bấm vô hình, rồi kiểm tra thử xem:

Mã:

Sub GLL()
Dim Arr(), vlArr(), I, J, K, DK1, DK2, Ws, lr, x, y
With Sheet1
 lr = .Range("A" & Rows.Count).End(3).Row
 Arr = .Range("A3:I" & lr).Value
End With
Ws = Array(Sheet2, Sheet3)
For J = 0 To UBound(Ws)
 With Ws(J)
 K = 0: x = 0: y = 0
 ReDim vlArr(1 To UBound(Arr, 1), 1 To 5)
   DK1 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr)) * 0.1
   DK2 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("I4:I" & lr)) * 0.1
   For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> Empty And Arr(I, 3) = .Name And _
    IIf(J = 0, (Arr(I, 4) >= DK1 Or Arr(I, 8) >= DK1), (Arr(I, 5) >= DK2 Or Arr(I, 9) >= DK2)) Then
         K = K + 1
          vlArr(K, 1) = Arr(I, 1)
          vlArr(K, 2) = Arr(I, 2)
          vlArr(K, 3) = "'" & Arr(I, 3)
          vlArr(K, 4) = Arr(I, 4 + J)
          vlArr(K, 5) = Arr(I, 8 + J)
          x = x + vlArr(K, 4)
          y = y + vlArr(K, 5)
    End If
   Next
   .[A3:E10000].ClearContents
   .[A3].Resize(K, 5) = vlArr
   .[A3].Offset(K) = "Other"
   .[B3].Offset(K) = "Other Clients"
   .[C3].Offset(K) = "'" & .Name
   .[B3].Offset(K + 1) = "Total"
   .[D3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("D4:D" & lr).Offset(, J))
   .[E3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr).Offset(, J))
   .[D3].Offset(K) = .[D3].Offset(K + 1) - x
   .[E3].Offset(K) = .[E3].Offset(K + 1) - y
 End With
Next
End Sub

satthuvae · 20/1/16

giangleloi đã viết:

Xem file bấm vô hình, rồi kiểm tra thử xem:

Mã:

Sub GLL()
Dim Arr(), vlArr(), I, J, K, DK1, DK2, Ws, lr, x, y
With Sheet1
 lr = .Range("A" & Rows.Count).End(3).Row
 Arr = .Range("A3:I" & lr).Value
End With
Ws = Array(Sheet2, Sheet3)
For J = 0 To UBound(Ws)
 With Ws(J)
 K = 0: x = 0: y = 0
 ReDim vlArr(1 To UBound(Arr, 1), 1 To 5)
   DK1 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr)) * 0.1
   DK2 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("I4:I" & lr)) * 0.1
   For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> Empty And Arr(I, 3) = .Name And _
    IIf(J = 0, (Arr(I, 4) >= DK1 Or Arr(I, 8) >= DK1), (Arr(I, 5) >= DK2 Or Arr(I, 9) >= DK2)) Then
         K = K + 1
          vlArr(K, 1) = Arr(I, 1)
          vlArr(K, 2) = Arr(I, 2)
          vlArr(K, 3) = "'" & Arr(I, 3)
          vlArr(K, 4) = Arr(I, 4 + J)
          vlArr(K, 5) = Arr(I, 8 + J)
          x = x + vlArr(K, 4)
          y = y + vlArr(K, 5)
    End If
   Next
   .[A3:E10000].ClearContents
   .[A3].Resize(K, 5) = vlArr
   .[A3].Offset(K) = "Other"
   .[B3].Offset(K) = "Other Clients"
   .[C3].Offset(K) = "'" & .Name
   .[B3].Offset(K + 1) = "Total"
   .[D3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("D4:D" & lr).Offset(, J))
   .[E3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr).Offset(, J))
   .[D3].Offset(K) = .[D3].Offset(K + 1) - x
   .[E3].Offset(K) = .[E3].Offset(K + 1) - y
 End With
Next
End Sub

Cám ơn bạn rất nhiều ah
Tuyệt vời quá ah.

satthuvae · 21/1/16

giangleloi đã viết:

Xem file bấm vô hình, rồi kiểm tra thử xem:

Mã:

Sub GLL()
Dim Arr(), vlArr(), I, J, K, DK1, DK2, Ws, lr, x, y
With Sheet1
 lr = .Range("A" & Rows.Count).End(3).Row
 Arr = .Range("A3:I" & lr).Value
End With
Ws = Array(Sheet2, Sheet3)
For J = 0 To UBound(Ws)
 With Ws(J)
 K = 0: x = 0: y = 0
 ReDim vlArr(1 To UBound(Arr, 1), 1 To 5)
   DK1 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr)) * 0.1
   DK2 = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("I4:I" & lr)) * 0.1
   For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> Empty And Arr(I, 3) = .Name And _
    IIf(J = 0, (Arr(I, 4) >= DK1 Or Arr(I, 8) >= DK1), (Arr(I, 5) >= DK2 Or Arr(I, 9) >= DK2)) Then
         K = K + 1
          vlArr(K, 1) = Arr(I, 1)
          vlArr(K, 2) = Arr(I, 2)
          vlArr(K, 3) = "'" & Arr(I, 3)
          vlArr(K, 4) = Arr(I, 4 + J)
          vlArr(K, 5) = Arr(I, 8 + J)
          x = x + vlArr(K, 4)
          y = y + vlArr(K, 5)
    End If
   Next
   .[A3:E10000].ClearContents
   .[A3].Resize(K, 5) = vlArr
   .[A3].Offset(K) = "Other"
   .[B3].Offset(K) = "Other Clients"
   .[C3].Offset(K) = "'" & .Name
   .[B3].Offset(K + 1) = "Total"
   .[D3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("D4:D" & lr).Offset(, J))
   .[E3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C4:C" & lr), .Name, Sheet1.Range("H4:H" & lr).Offset(, J))
   .[D3].Offset(K) = .[D3].Offset(K + 1) - x
   .[E3].Offset(K) = .[E3].Offset(K + 1) - y
 End With
Next
End Sub

Chào bạn, hôm nay mình chạy số liệu khác, mới phát hiện chưa cộng hết một số cột, bạn có thể xem giùm mình không.
Khi lọc 131, thì ko lên ô H3 và khi lọc 331 thì ko lên ô I134.
Minh gửi file đính kèm.
Cám ơn bạn đã giúp đỡ.

satthuvae · 21/1/16

hpkhuong đã viết:

Mã:

Sub GLL()
Dim Arr(), vlArr(), I, J, K, DK1, DK2, Ws, lr, x, y
With Sheet1
 lr = .Range("A" & Rows.Count).End(3).Row - 1
 Arr = .Range("A3:I" & lr).Value
End With
Ws = Array(Sheet2, Sheet3)
For J = 0 To UBound(Ws)
 With Ws(J)
 K = 0: x = 0: y = 0
 ReDim vlArr(1 To UBound(Arr, 1), 1 To 5)
   DK1 = WorksheetFunction.SumIf(Sheet1.Range("C3:C" & lr), .Name, Sheet1.Range("H3:H" & lr)) * 0.1
   DK2 = WorksheetFunction.SumIf(Sheet1.Range("C3:C" & lr), .Name, Sheet1.Range("I3:I" & lr)) * 0.1
   For I = 1 To UBound(Arr, 1)
    If Arr(I, 1) <> Empty And Arr(I, 3) = .Name And _
    IIf(J = 0, (Arr(I, 4) >= DK1 Or Arr(I, 8) >= DK1), (Arr(I, 5) >= DK2 Or Arr(I, 9) >= DK2)) Then
         K = K + 1
          vlArr(K, 1) = Arr(I, 1)
          vlArr(K, 2) = Arr(I, 2)
          vlArr(K, 3) = "'" & Arr(I, 3)
          vlArr(K, 4) = Arr(I, 4 + J)
          vlArr(K, 5) = Arr(I, 8 + J)
          x = x + vlArr(K, 4)
          y = y + vlArr(K, 5)
    End If
   Next
   .[A3:E10000].ClearContents
   .[A3].Resize(K, 5) = vlArr
   .[A3].Offset(K) = "Other"
   .[B3].Offset(K) = "Other Clients"
   .[C3].Offset(K) = "'" & .Name
   .[B3].Offset(K + 1) = "Total"
   .[D3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C3:C" & lr), .Name, Sheet1.Range("D3:D" & lr).Offset(, J))
   .[E3].Offset(K + 1) = WorksheetFunction.SumIf(Sheet1.Range("C3:C" & lr), .Name, Sheet1.Range("H3:H" & lr).Offset(, J))
   .[D3].Offset(K) = .[D3].Offset(K + 1) - x
   .[E3].Offset(K) = .[E3].Offset(K + 1) - y
 End With
Next
End Sub

Em cám ơn anh hpkhuong à.

Tổng hợp công nợ theo điều kiện

satthuvae

Thành viên thường trực

File đính kèm

hophoang

Thành viên tiêu biểu

File đính kèm

satthuvae

Thành viên thường trực

giangleloi

Thành viên gắn bó

File đính kèm

satthuvae

Thành viên thường trực

satthuvae

Thành viên thường trực

File đính kèm

satthuvae

Thành viên thường trực

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng