Kiểm tra ngày tiền ngân hàng về

Liên hệ QC

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
Chào các anh/chị, em có vấn đề xin mọi người giúp đỡ
Hàng ngày, công ty quẹt thẻ (Visa, ATM, Master,..) của khách hàng, và mỗi ngày ngân hàng cũng sẽ gửi danh sách số tiền ghi Có tài khoản
Quẹt thẻ ngày T thì ngân hàng có thể báo tiền về ngày T, T+1, T+2 hoặc T+3, nếu có sự cố thì tiền k về
Mục tiêu của em là ghép dữ liệu Số thẻ, số tiền mà ngân hàng ghi nhận với Số thẻ, số tiền cty đã quẹt thẻ, để theo dõi thẻ nào đã về tiền, thẻ nào chưa về tiền
Vấn đề là một thẻ cty quẹt nhiều lần nhưng ngân hàng có thể báo về số tiền tổng các lần quẹt của thẻ đó
Ví dụ ngày 1 quẹt thẻ A 5 lần với số tiền 10, 5, 12, 3, 25. tổng 55. thì ngân hàng có thể về tiền các trường hợp sau: (ngày 2 tiền về đủ 55) hoặc (ngày 2 về 27 + ngày 3 về 28) hoặc (ngày 2 về 10+ngày 3 về 20+ngày 4 về 25), nói chung ngân hàng có thể gộp các khoản của 1 thẻ về một cách không biết trước được, anh/chị có thể tham khảo trường hợp thẻ 8811 ngày 19/6 như trong file đính kèm
Điều kiện kiểm tra của em là
1.Số thẻ phải giống nhau
2.Tiền bằng nhau, hoặc tiền ngân hàng về bằng tổng tiền các lần quẹt (tức là ngân hàng có thể gộp các lần quẹt chứ không chia tách tiền mỗi lần quẹt)
3.Nếu điều kiện 1+2 như nhau thì ưu tên thời gian quẹt thẻ (cột J "post time") :cái này cũng k quan trọng lắm, chủ yếu đk1-số thẻ, đk2- số tiền

Trong file đính kèm, sheet "SMILE" cột B-J là dữ liệu quẹt thẻ của cty kết xuất từ phần mềm, kết quả cột L em đã dò thủ công, sheet "VCB mail" là em đã gom mail ngân hàng 3 ngày để ví dụ, thực tế dữ liệu "VCB mail" là theo từng ngày thôi
Vì mail ngân hàng báo theo ngày và em kiểm tra mỗi ngày nên muốn kết quả cột L cập nhật tiếp kết quả kiểm tra ngày mới, còn ngày cũ đã check thì giữ nguyên
Mong nhận được sự hỗ trợ của mọi người. Em chân thành cảm ơn!
 

File đính kèm

  • Card 2022.xlsm
    76.7 KB · Đọc: 24

Maika8008

Thành viên gạo cội
Tham gia
12/6/20
Bài viết
3,559
Được thích
3,940
Donate (Momo)
Donate
Giới tính
Nam
Cái hệ thống ngân hàng làm việc sao thiếu quy tắc vậy nhỉ. Thà cứ lần nào ra lần ấy chứ gộp kiểu thế thì khác nào đánh đố khách hàng.
 

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
Có cao nhân nào tham khảo hỗ trợ giúp e vấn đề này được k ạ. Em cảm ơn!
 

VetMini

Ăn cùng góc phố
Tham gia
21/12/12
Bài viết
14,079
Được thích
18,575
Cái hệ thống ngân hàng làm việc sao thiếu quy tắc vậy nhỉ. Thà cứ lần nào ra lần ấy chứ gộp kiểu thế thì khác nào đánh đố khách hàng.
Quy tắc của họ là "gộp". Họ là chủ, đâu cố bắt theo quy tắc của mình được.

Đối chiếu thu nhập từ thẻ tín dụng là một công việc tương đối khó.
Mà cái này là của bộ phận Kế toán. Họ có quy tắc và quy trình của họ. Đâu có làm khơi khơi theo ý mình được.
 

87kilua

Thành viên hoạt động
Tham gia
19/11/21
Bài viết
113
Được thích
40
Xem Xem thử xem sao. . . . .
 

File đính kèm

  • Card 2022 (1).xlsm
    94.1 KB · Đọc: 9

87kilua

Thành viên hoạt động
Tham gia
19/11/21
Bài viết
113
Được thích
40
Cảm ơn bạn đã phản hồi, nhưng mình k hiểu ý của bạn, mình cần kết quả là ngày tiền về chứ k phải tách lấy ngày Post time
Ngày tiền về từ file của ngân hàng, sort (sắp xếp) các TK ngày tiền về điền thông tin sang sổ nhập liệu tay. Có bao nhiêu ngày tiền về thì sort bấy nhiêu lần. Cũng hơi lằng nhằng,. Tôi chưa nghĩ ra công thức nhưng nếu phải làm thủ công tôi sẽ làm vậy
Bài đã được tự động gộp:

1656571060397.png
 

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
nhưng kết quả mình thấy chưa đúng, ngày tiền về của bạn là cột nào? mình đã check thủ công là kết quả cột "VCB date"
 

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
9,040
Được thích
19,863
Chào các anh/chị, em có vấn đề xin mọi người giúp đỡ
Hàng ngày, công ty quẹt thẻ (Visa, ATM, Master,..) của khách hàng, và mỗi ngày ngân hàng cũng sẽ gửi danh sách số tiền ghi Có tài khoản
Quẹt thẻ ngày T thì ngân hàng có thể báo tiền về ngày T, T+1, T+2 hoặc T+3, nếu có sự cố thì tiền k về
Mục tiêu của em là ghép dữ liệu Số thẻ, số tiền mà ngân hàng ghi nhận với Số thẻ, số tiền cty đã quẹt thẻ, để theo dõi thẻ nào đã về tiền, thẻ nào chưa về tiền
Vấn đề là một thẻ cty quẹt nhiều lần nhưng ngân hàng có thể báo về số tiền tổng các lần quẹt của thẻ đó
Ví dụ ngày 1 quẹt thẻ A 5 lần với số tiền 10, 5, 12, 3, 25. tổng 55. thì ngân hàng có thể về tiền các trường hợp sau: (ngày 2 tiền về đủ 55) hoặc (ngày 2 về 27 + ngày 3 về 28) hoặc (ngày 2 về 10+ngày 3 về 20+ngày 4 về 25), nói chung ngân hàng có thể gộp các khoản của 1 thẻ về một cách không biết trước được, anh/chị có thể tham khảo trường hợp thẻ 8811 ngày 19/6 như trong file đính kèm
Điều kiện kiểm tra của em là
1.Số thẻ phải giống nhau
2.Tiền bằng nhau, hoặc tiền ngân hàng về bằng tổng tiền các lần quẹt (tức là ngân hàng có thể gộp các lần quẹt chứ không chia tách tiền mỗi lần quẹt)
3.Nếu điều kiện 1+2 như nhau thì ưu tên thời gian quẹt thẻ (cột J "post time") :cái này cũng k quan trọng lắm, chủ yếu đk1-số thẻ, đk2- số tiền

Trong file đính kèm, sheet "SMILE" cột B-J là dữ liệu quẹt thẻ của cty kết xuất từ phần mềm, kết quả cột L em đã dò thủ công, sheet "VCB mail" là em đã gom mail ngân hàng 3 ngày để ví dụ, thực tế dữ liệu "VCB mail" là theo từng ngày thôi
Vì mail ngân hàng báo theo ngày và em kiểm tra mỗi ngày nên muốn kết quả cột L cập nhật tiếp kết quả kiểm tra ngày mới, còn ngày cũ đã check thì giữ nguyên
Mong nhận được sự hỗ trợ của mọi người. Em chân thành cảm ơn!
Chạy sub main, kiểm tra lại kết quả
Mã:
Option Explicit

Sub Main()
  Dim arr(), aDL(), S, res
  Dim sR&, sRow&, eR&, i&, j&, ngay, card, t

  With Sheets("SMILE")
    aDL = .Range("H3:K" & .Range("K1048000").End(xlUp).Row).Value
    sR = UBound(aDL)
    res = .Range("L3").Resize(sR).Value
  End With
 
  With Sheets("VCB mail")
    For j = 1 To 366 Step 3 'xet nhieu nhat 366 ngày
      ngay = .Cells(1, j).Value
      If ngay <> Empty And IsDate(ngay) Then
        eR = .Cells(1048000, j).End(xlUp).Row
        If eR > 3 Then
          arr = .Range(.Cells(3, j), .Cells(eR, j + 1)).Value
          sRow = UBound(arr)
          For i = 1 To sRow
            If arr(i, 2) > 0 Then
              S = Split("*" & arr(i, 1), "*")
              card = S(UBound(S))
              Call SumFind(card, ngay, arr(i, 2), aDL, res, sR)
            End If
          Next i
        End If
      Else
        Exit For
      End If
    Next j
  End With
  Sheets("SMILE").Range("L3").Resize(sR) = res
End Sub

Private Sub SumFind(card, ngay, Total, aDL, res, sR)
  Dim Data(), arr(), tmp, tSum As Double
  Dim i&, N&, k&, j&

  For i = 1 To sR
    If res(i, 1) = Empty And CStr(aDL(i, 4)) = card Then
      If Int(aDL(i, 3)) <= ngay Then
        tmp = -aDL(i, 1)
        If tmp = Total Then
          res(i, 1) = "nh " & Format(ngay, "d/m")
          Exit Sub
        ElseIf tmp < Total And tmp > 0 Then
          N = N + 1
          ReDim Preserve Data(1 To 3, 1 To N)
          Data(1, N) = tmp: Data(2, N) = i:  Data(3, N) = "nh " & Format(ngay, "d/m")
        End If
      End If
    End If
  Next i
 
  Call QuickSort(Data)
  ReDim arr(1 To N)
  arr(1) = 1:     tSum = Data(1, 1)
  N = 1:          k = 1
  Do While Total <> -1 'tSum
    If arr(1) = UBound(Data, 2) Then Exit Sub
    If tSum > Total Then
      k = arr(N - 1) + 1
      tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
      N = N - 1
      arr(N) = k
    Else
      If k = UBound(Data, 2) Then
        k = arr(N - 1) + 1
        tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
        N = N - 1
        arr(N) = k
      Else
        k = k + 1
        tSum = tSum + Data(1, k)
        N = N + 1
        arr(N) = k
      End If
    End If
    If Total = tSum Then
      For i = 1 To N
        j = arr(i)
        res(Data(2, j), 1) = Data(3, j)
      Next i
      Exit Sub
    End If
  Loop
End Sub

Private Sub QuickSort(Data)
  Dim oSList As Object, sArr, S
  Dim j As Long, k As Long, jk As Long, m As Long

  Set oSList = CreateObject("System.Collections.SortedList")
  For j = LBound(Data, 2) To UBound(Data, 2)
    oSList.Item(Data(1, j)) = oSList.Item(Data(1, j)) & "," & j
  Next j
  sArr = Data
  For j = 0 To oSList.Count - 1
    S = Split(oSList.GetByIndex(j), ",")
    For m = 1 To UBound(S)
      jk = CLng(S(m))
        k = k + 1
        Data(1, k) = sArr(1, jk): Data(2, k) = sArr(2, jk)
    Next m
  Next j
  Set oSList = Nothing
End Sub
 

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
Chạy sub main, kiểm tra lại kết quả
Mã:
Option Explicit

Sub Main()
  Dim arr(), aDL(), S, res
  Dim sR&, sRow&, eR&, i&, j&, ngay, card, t

  With Sheets("SMILE")
    aDL = .Range("H3:K" & .Range("K1048000").End(xlUp).Row).Value
    sR = UBound(aDL)
    res = .Range("L3").Resize(sR).Value
  End With
 
  With Sheets("VCB mail")
    For j = 1 To 366 Step 3 'xet nhieu nhat 366 ngày
      ngay = .Cells(1, j).Value
      If ngay <> Empty And IsDate(ngay) Then
        eR = .Cells(1048000, j).End(xlUp).Row
        If eR > 3 Then
          arr = .Range(.Cells(3, j), .Cells(eR, j + 1)).Value
          sRow = UBound(arr)
          For i = 1 To sRow
            If arr(i, 2) > 0 Then
              S = Split("*" & arr(i, 1), "*")
              card = S(UBound(S))
              Call SumFind(card, ngay, arr(i, 2), aDL, res, sR)
            End If
          Next i
        End If
      Else
        Exit For
      End If
    Next j
  End With
  Sheets("SMILE").Range("L3").Resize(sR) = res
End Sub

Private Sub SumFind(card, ngay, Total, aDL, res, sR)
  Dim Data(), arr(), tmp, tSum As Double
  Dim i&, N&, k&, j&

  For i = 1 To sR
    If res(i, 1) = Empty And CStr(aDL(i, 4)) = card Then
      If Int(aDL(i, 3)) <= ngay Then
        tmp = -aDL(i, 1)
        If tmp = Total Then
          res(i, 1) = "nh " & Format(ngay, "d/m")
          Exit Sub
        ElseIf tmp < Total And tmp > 0 Then
          N = N + 1
          ReDim Preserve Data(1 To 3, 1 To N)
          Data(1, N) = tmp: Data(2, N) = i:  Data(3, N) = "nh " & Format(ngay, "d/m")
        End If
      End If
    End If
  Next i
 
  Call QuickSort(Data)
  ReDim arr(1 To N)
  arr(1) = 1:     tSum = Data(1, 1)
  N = 1:          k = 1
  Do While Total <> -1 'tSum
    If arr(1) = UBound(Data, 2) Then Exit Sub
    If tSum > Total Then
      k = arr(N - 1) + 1
      tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
      N = N - 1
      arr(N) = k
    Else
      If k = UBound(Data, 2) Then
        k = arr(N - 1) + 1
        tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
        N = N - 1
        arr(N) = k
      Else
        k = k + 1
        tSum = tSum + Data(1, k)
        N = N + 1
        arr(N) = k
      End If
    End If
    If Total = tSum Then
      For i = 1 To N
        j = arr(i)
        res(Data(2, j), 1) = Data(3, j)
      Next i
      Exit Sub
    End If
  Loop
End Sub

Private Sub QuickSort(Data)
  Dim oSList As Object, sArr, S
  Dim j As Long, k As Long, jk As Long, m As Long

  Set oSList = CreateObject("System.Collections.SortedList")
  For j = LBound(Data, 2) To UBound(Data, 2)
    oSList.Item(Data(1, j)) = oSList.Item(Data(1, j)) & "," & j
  Next j
  sArr = Data
  For j = 0 To oSList.Count - 1
    S = Split(oSList.GetByIndex(j), ",")
    For m = 1 To UBound(S)
      jk = CLng(S(m))
        k = k + 1
        Data(1, k) = sArr(1, jk): Data(2, k) = sArr(2, jk)
    Next m
  Next j
  Set oSList = Nothing
End Sub
thật tuyệt vời, cảm ơn anh nhiều. em chưa đủ trình độ để hiểu được vba của anh nhưng thấy chạy mà đã :)). Mong anh có thể giải thích thêm về ý tưởng lập trình để xử lý vấn đề kiểm tra các thẻ bị gộp
 

HieuCD

Chuyên gia GPE
Tham gia
14/9/10
Bài viết
9,040
Được thích
19,863
thật tuyệt vời, cảm ơn anh nhiều. em chưa đủ trình độ để hiểu được vba của anh nhưng thấy chạy mà đã :)). Mong anh có thể giải thích thêm về ý tưởng lập trình để xử lý vấn đề kiểm tra các thẻ bị gộp
Ưu tiên dò tìm số tiền thanh toán = số tiền sao kê ngân hàng, nếu không có dòng nào trung khớp sẽ lấy các dữ liệu có số tiền >0 và < số tiền sao kê đưa vào mảng Data và dùng thuật toán vét cạn xét tất cả các tổ hợp tổng số tiền thanh toán=số tiền sao kê
Thuật toán nầy khá phức tạp nên khó giải thích
Mã:
Option Explicit

Sub Main()
  Dim arr(), aDL(), S, res
  Dim sR&, sRow&, eR&, i&, j&, ngay, card, t

  With Sheets("SMILE")
    aDL = .Range("H3:K" & .Range("K1048000").End(xlUp).Row).Value
    sR = UBound(aDL)
    res = .Range("L3").Resize(sR).Value
  End With
 
  With Sheets("VCB mail")
    For j = 1 To 366 Step 3 'xet nhieu nhat 366 ngày
      ngay = .Cells(1, j).Value 'Ngay sao ke
      If ngay <> Empty And IsDate(ngay) Then 'co du lieu Sao ke ngan hang
        eR = .Cells(1048000, j).End(xlUp).Row 'Dong cuoi
        If eR > 3 Then
          arr = .Range(.Cells(3, j), .Cells(eR, j + 1)).Value 'Mang du lieu sao ke 1 ngay
          sRow = UBound(arr)
          For i = 1 To sRow
            If arr(i, 2) > 0 Then
              S = Split("*" & arr(i, 1), "*")
              card = S(UBound(S)) 'Card No.
              Call SumFind(card, ngay, arr(i, 2), aDL, res, sR)
            End If
          Next i
        End If
      Else 'Het du lieu ngan hang
        Exit For
      End If
    Next j
  End With
  Sheets("SMILE").Range("L3").Resize(sR) = res
End Sub

Private Sub SumFind(card, ngay, Total, aDL, res, sR)
'Tìm các ket qua so tien thanh toan cua khach hang phu hop voi so tien sao ke "Total"
  Dim Data(), arr(), tmp, tSum As Double
  Dim i&, N&, k&, j&

  For i = 1 To sR
    If res(i, 1) = Empty And CStr(aDL(i, 4)) = card Then 'Xet dong Card No. và chua co VCB date
      If Int(aDL(i, 3)) <= ngay Then 'Xet Ngay quet the <= ngay sao ke
        tmp = -aDL(i, 1) 'So tien
' Tìm "So tien = So tien sao ke" Gán ngày sao ke vào mang ket qua
' Neu khong tìm thay dung thuat toán vét can tim tong các so tien = so tien sao ke
        If tmp = Total Then 'Xet So tien = So tien sao ke
          res(i, 1) = "nh " & Format(ngay, "d/m")
          Exit Sub
        ElseIf tmp < Total And tmp > 0 Then ' Neu khong tìm thay So tien = So tien sao ke, gan du lieu vao mang Data
          N = N + 1
          ReDim Preserve Data(1 To 3, 1 To N)
          Data(1, N) = tmp 'So Tien
          Data(2, N) = i 'Thu tu dong ket qua
          Data(3, N) = "nh " & Format(ngay, "d/m") 'gia tri Ket qua
        End If
      End If
    End If
  Next i

'Thuat toán vet can, tim tong các so tien = so tien sao ke
  Call QuickSort(Data) 'sort mang Data theo so tien tu nho toi lon
  ReDim arr(1 To N)
  arr(1) = 1:     tSum = Data(1, 1)
  N = 1:          k = 1
  Do While Total <> -1 'tSum
    If arr(1) = UBound(Data, 2) Then Exit Sub
    If tSum > Total Then
      k = arr(N - 1) + 1
      tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
      N = N - 1
      arr(N) = k
    Else
      If k = UBound(Data, 2) Then
        k = arr(N - 1) + 1
        tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
        N = N - 1
        arr(N) = k
      Else
        k = k + 1
        tSum = tSum + Data(1, k)
        N = N + 1
        arr(N) = k
      End If
    End If
    If Total = tSum Then
      For i = 1 To N
        j = arr(i)
        res(Data(2, j), 1) = Data(3, j)
      Next i
      Exit Sub
    End If
  Loop
End Sub

Private Sub QuickSort(Data) 'Sort theo cot cua mang 2 chieu tu nho toi lon
  Dim oSList As Object, sArr, S
  Dim j As Long, k As Long, jk As Long, m As Long

  Set oSList = CreateObject("System.Collections.SortedList")
  For j = LBound(Data, 2) To UBound(Data, 2)
    oSList.Item(Data(1, j)) = oSList.Item(Data(1, j)) & "," & j
  Next j
  sArr = Data
  For j = 0 To oSList.Count - 1
    S = Split(oSList.GetByIndex(j), ",")
    For m = 1 To UBound(S)
      jk = CLng(S(m))
        k = k + 1
        Data(1, k) = sArr(1, jk): Data(2, k) = sArr(2, jk)
    Next m
  Next j
  Set oSList = Nothing
End Sub
 

yeungannam003

Thành viên mới
Tham gia
15/12/20
Bài viết
9
Được thích
6
Ưu tiên dò tìm số tiền thanh toán = số tiền sao kê ngân hàng, nếu không có dòng nào trung khớp sẽ lấy các dữ liệu có số tiền >0 và < số tiền sao kê đưa vào mảng Data và dùng thuật toán vét cạn xét tất cả các tổ hợp tổng số tiền thanh toán=số tiền sao kê
Thuật toán nầy khá phức tạp nên khó giải thích
Mã:
Option Explicit

Sub Main()
  Dim arr(), aDL(), S, res
  Dim sR&, sRow&, eR&, i&, j&, ngay, card, t

  With Sheets("SMILE")
    aDL = .Range("H3:K" & .Range("K1048000").End(xlUp).Row).Value
    sR = UBound(aDL)
    res = .Range("L3").Resize(sR).Value
  End With
 
  With Sheets("VCB mail")
    For j = 1 To 366 Step 3 'xet nhieu nhat 366 ngày
      ngay = .Cells(1, j).Value 'Ngay sao ke
      If ngay <> Empty And IsDate(ngay) Then 'co du lieu Sao ke ngan hang
        eR = .Cells(1048000, j).End(xlUp).Row 'Dong cuoi
        If eR > 3 Then
          arr = .Range(.Cells(3, j), .Cells(eR, j + 1)).Value 'Mang du lieu sao ke 1 ngay
          sRow = UBound(arr)
          For i = 1 To sRow
            If arr(i, 2) > 0 Then
              S = Split("*" & arr(i, 1), "*")
              card = S(UBound(S)) 'Card No.
              Call SumFind(card, ngay, arr(i, 2), aDL, res, sR)
            End If
          Next i
        End If
      Else 'Het du lieu ngan hang
        Exit For
      End If
    Next j
  End With
  Sheets("SMILE").Range("L3").Resize(sR) = res
End Sub

Private Sub SumFind(card, ngay, Total, aDL, res, sR)
'Tìm các ket qua so tien thanh toan cua khach hang phu hop voi so tien sao ke "Total"
  Dim Data(), arr(), tmp, tSum As Double
  Dim i&, N&, k&, j&

  For i = 1 To sR
    If res(i, 1) = Empty And CStr(aDL(i, 4)) = card Then 'Xet dong Card No. và chua co VCB date
      If Int(aDL(i, 3)) <= ngay Then 'Xet Ngay quet the <= ngay sao ke
        tmp = -aDL(i, 1) 'So tien
' Tìm "So tien = So tien sao ke" Gán ngày sao ke vào mang ket qua
' Neu khong tìm thay dung thuat toán vét can tim tong các so tien = so tien sao ke
        If tmp = Total Then 'Xet So tien = So tien sao ke
          res(i, 1) = "nh " & Format(ngay, "d/m")
          Exit Sub
        ElseIf tmp < Total And tmp > 0 Then ' Neu khong tìm thay So tien = So tien sao ke, gan du lieu vao mang Data
          N = N + 1
          ReDim Preserve Data(1 To 3, 1 To N)
          Data(1, N) = tmp 'So Tien
          Data(2, N) = i 'Thu tu dong ket qua
          Data(3, N) = "nh " & Format(ngay, "d/m") 'gia tri Ket qua
        End If
      End If
    End If
  Next i

'Thuat toán vet can, tim tong các so tien = so tien sao ke
  Call QuickSort(Data) 'sort mang Data theo so tien tu nho toi lon
  ReDim arr(1 To N)
  arr(1) = 1:     tSum = Data(1, 1)
  N = 1:          k = 1
  Do While Total <> -1 'tSum
    If arr(1) = UBound(Data, 2) Then Exit Sub
    If tSum > Total Then
      k = arr(N - 1) + 1
      tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
      N = N - 1
      arr(N) = k
    Else
      If k = UBound(Data, 2) Then
        k = arr(N - 1) + 1
        tSum = tSum - Data(1, arr(N)) - Data(1, arr(N - 1)) + Data(1, k)
        N = N - 1
        arr(N) = k
      Else
        k = k + 1
        tSum = tSum + Data(1, k)
        N = N + 1
        arr(N) = k
      End If
    End If
    If Total = tSum Then
      For i = 1 To N
        j = arr(i)
        res(Data(2, j), 1) = Data(3, j)
      Next i
      Exit Sub
    End If
  Loop
End Sub

Private Sub QuickSort(Data) 'Sort theo cot cua mang 2 chieu tu nho toi lon
  Dim oSList As Object, sArr, S
  Dim j As Long, k As Long, jk As Long, m As Long

  Set oSList = CreateObject("System.Collections.SortedList")
  For j = LBound(Data, 2) To UBound(Data, 2)
    oSList.Item(Data(1, j)) = oSList.Item(Data(1, j)) & "," & j
  Next j
  sArr = Data
  For j = 0 To oSList.Count - 1
    S = Split(oSList.GetByIndex(j), ",")
    For m = 1 To UBound(S)
      jk = CLng(S(m))
        k = k + 1
        Data(1, k) = sArr(1, jk): Data(2, k) = sArr(2, jk)
    Next m
  Next j
  Set oSList = Nothing
End Sub
Một lần nữa cảm ơn anh Hiếu đã nhiệt tình giúp đỡ. e sẽ nghiên cứu dần vba của a. Chúc a sức khỏe!
 
Web KT

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL
Top Bottom