bongmaihung
Thành viên hoạt động



- Tham gia
- 7/8/14
- Bài viết
- 173
- Được thích
- 39
Dữ liệu thực tế rất nhiều. Em nhờ anh chị giúp ah, Hàm em làm được rồi.có 1 dòng thôi cần chi tới VBA bạn, sử dụng hàm được rồi
Trong một ngày có thể nhập rất nhiều lần anh ah,theo như bạn nói thì chọn ngày nào nó ra ngày đó mà nhiều cái gì?
Em đang đi ra ngoài và vào bằng điện t hoại, anh nói đúng rồi đấy ah, lọc mặt hàng duy nhất, tính tổng theo ngày. File thực tế y hệt file vừa rồi, anh làm giúp em trên file này, em biết qua vba nên có thể sửa được ah. Em cảm ơn anhhêm dữ liệu đi, tôi sẽ làm cho bạn, ý bạn nói là trong một ngày có rất nhiều mặt hàng, mà nó được nhập nhiều lần, bạn muốn hiện ra một mã hàng duy nhất trong nhiều lần nhập và tính tổng tiền mã hàng đó ?
Em thử dùng Dictionary rồi nhưng chắc sai chỗ nào đó, còn số liệu thì cũng minh bạch thôi anh, lọc trùng rồi tính t ổng số lượng và doanh thu theo ngày thôi ahThường thường ba cái quản lý mua bán này bạn phải biết cách tự viết lấy code. Có một vài chỗ bí thì nhờ bà con GPE chỉ dẫn.
Một đống dữ liệu, một đống quy trình, bạn nhờ viết từ A đến Z thì lúc sếp bạn hỏi một vài con số đáng nghi ngờ, bạn phải chứng mình cách nào? Ví dụ nó có chỗ sai thật, và sở thuế bảo rằng bạn cố tình tính gian để trốn thuế thì bạn biện hộ cách nào?
Public Sub GPE()
Dim Dic As Object, Arr(), I As Long, J As Long, K As Long
Dim rng As Range
Dim DK
Dim Tem
Application.ScreenUpdating = False
Set Dic = CreateObject("Scripting.Dictionary")
Dongcuoi = Sheet5.Range("B65000").End(xlUp).Row
Set rng = Sheet5.Range("B3:I" & Dongcuoi)
DK = Sheet6.Range("D2")
ReDim Arr(1 To Dongcuoi, 1 To 6)
K = 0
For I = 1 To Dongcuoi - 2
If (rng(I, 1) = DK) Then
Tem = rng(I, 2)
If Not Dic.Exists(Tem) Then
K = K + 1
Dic.Add Tem, K
Arr(K, 1) = K
Arr(K, 2) = rng(I, 2)
Arr(K, 3) = rng(I, 3)
Arr(K, 4) = rng(I, 4)
Arr(K, 5) = rng(I, 6)
Arr(K, 6) = rng(I, 8)
Else
J = Dic.Item(Tem)
Arr(K, 5) = Arr(J, 5) + rng(I, 6)
Arr(K, 6) = Arr(J, 6) + rng(I, 8)
End If
End If
Next I
Sheet6.Range("A6:F10000").ClearContents
Sheet6.Range("A6:F10000").Borders.LineStyle = 0
If (K > 0) Then
Sheet6.Range("A6").Resize(K, 6) = Arr
Sheet6.Range("A6").Resize(K, 6).Borders.LineStyle = 1
End If
Set Dic = Nothing
Application.ScreenUpdating = True
End Sub
Đúng yêu cầu rồi anh. Cảm ơn anh nhiều ahGởi bạn, bạn xem đúng ý không, bạn muốn DIC thì tôi làm DIC cho bạn
code bạn tự phát triển nha, tôi không bẫy lỗi gì nhiều, tôi chỉ làm cái sườn theo yêu cầu của bạn thôi
Mã:Public Sub GPE() Dim Dic As Object, Arr(), I As Long, J As Long, K As Long Dim rng As Range Dim DK Dim Tem Application.ScreenUpdating = False Set Dic = CreateObject("Scripting.Dictionary") Dongcuoi = Sheet5.Range("B65000").End(xlUp).Row Set rng = Sheet5.Range("B3:I" & Dongcuoi) DK = Sheet6.Range("D2") ReDim Arr(1 To Dongcuoi, 1 To 6) K = 0 For I = 1 To Dongcuoi - 2 If (rng(I, 1) = DK) Then Tem = rng(I, 2) If Not Dic.Exists(Tem) Then K = K + 1 Dic.Add Tem, K Arr(K, 1) = K Arr(K, 2) = rng(I, 2) Arr(K, 3) = rng(I, 3) Arr(K, 4) = rng(I, 4) Arr(K, 5) = rng(I, 6) Arr(K, 6) = rng(I, 8) Else J = Dic.Item(Tem) Arr(K, 5) = Arr(J, 5) + rng(I, 6) Arr(K, 6) = Arr(J, 6) + rng(I, 8) End If End If Next I Sheet6.Range("A6:F10000").ClearContents Sheet6.Range("A6:F10000").Borders.LineStyle = 0 If (K > 0) Then Sheet6.Range("A6").Resize(K, 6) = Arr Sheet6.Range("A6").Resize(K, 6).Borders.LineStyle = 1 End If Set Dic = Nothing Application.ScreenUpdating = True End Sub