Làm sao để lấy giá trị lớn nhất trong cùng một ngày.

khuongvietphong · 16/2/15

Chào các thầy, cô, anh chị và các bạn trên diễn đàn GPE. Em có bài toán sau chưa biết cách giải quyết thế nào ,mong được sự giúp đỡ của mọi người. Tất cả em đã ghi trong File đính kèm ạ. Em xin cảm ơn.

SA_DQ · 16/2/15

Bạn xem file;
Mình xài DMAX với sự trợ giúp bỡi VBA

khuongvietphong · 16/2/15

HYen17 đã viết:
Bạn xem file;
Mình xài DMAX với sự trợ giúp bỡi VBA

Cảm ơn bạn nhiều lắm nhưng mình chưa biết gì về VBA bạn có cách nào khác không.

hoamattroicoi · 16/2/15

khuongvietphong đã viết:
Chào các thầy, cô, anh chị và các bạn trên diễn đàn GPE. Em có bài toán sau chưa biết cách giải quyết thế nào ,mong được sự giúp đỡ của mọi người. Tất cả em đã ghi trong File đính kèm ạ. Em xin cảm ơn.

Lâu rùi mình không viết code, bạn cũng có thể dùng thêm code này nhé :

PHP:

Function TinhTong(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4(), dArr()
Dim i As Long, kK As Long, k As Long, x As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value

ReDim dArr(1 To UBound(sArr1))
For i = 1 To UBound(sArr1, 1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            k = k + 1
            Dic.Add sArr4(i, 1), k
            dArr(k) = sArr3(i, 1)
            kQ = kQ + dArr(k)
        Else
            kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > dArr(kK) Then
            
                kQ = kQ + sArr3(i, 1) - dArr(kK)
                dArr(kK) = sArr3(i, 1)
        
            End If
        End If
    End If
Next
TinhTong = kQ
Set Dic = Nothing
End Function

Hoặc code này, ngắn hơn chút :

PHP:

Function TinhTong2(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4()
Dim i As Long, kK As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value
kQ = 0
For i = 1 To UBound(sArr1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            Dic.Add sArr4(i, 1), sArr3(i, 1)
            kQ = kQ + sArr3(i, 1)
        Else
        kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > kK Then
                kQ = kQ + sArr3(i, 1) - kK
                Dic.Item(sArr4(i, 1)) = sArr3(i, 1)
            End If
        End If
    End If
Next
TinhTong2 = kQ
Set Dic = Nothing
End Function

Chi tiết file đính kèm.

khuongvietphong · 17/2/15

hoamattroicoi đã viết:

Lâu rùi mình không viết code, bạn cũng có thể dùng thêm code này nhé :

PHP:

Function TinhTong(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4(), dArr()
Dim i As Long, kK As Long, k As Long, x As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value

ReDim dArr(1 To UBound(sArr1))
For i = 1 To UBound(sArr1, 1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            k = k + 1
            Dic.Add sArr4(i, 1), k
            dArr(k) = sArr3(i, 1)
            kQ = kQ + dArr(k)
        Else
            kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > dArr(kK) Then
            
                kQ = kQ + sArr3(i, 1) - dArr(kK)
                dArr(kK) = sArr3(i, 1)
        
            End If
        End If
    End If
Next
TinhTong = kQ
Set Dic = Nothing
End Function

Hoặc code này, ngắn hơn chút :

PHP:

Function TinhTong2(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4()
Dim i As Long, kK As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value
kQ = 0
For i = 1 To UBound(sArr1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            Dic.Add sArr4(i, 1), sArr3(i, 1)
            kQ = kQ + sArr3(i, 1)
        Else
        kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > kK Then
                kQ = kQ + sArr3(i, 1) - kK
                Dic.Item(sArr4(i, 1)) = sArr3(i, 1)
            End If
        End If
    End If
Next
TinhTong2 = kQ
Set Dic = Nothing
End Function

Chi tiết file đính kèm.

Cảm ơn bạn nhiều nhưng cho mình hỏi là nếu làm theo công thức thì làm thế nào hả bạn.

Let'GâuGâu · 17/2/15

khuongvietphong đã viết:
Cam on ban nhieu lam nhung minh chua biet gi ve VBA ban co cach nao khac khong.

bạn phải viết tiếng việt có dấu nha, đó là nội quy
============
thuc lam bẳng cthuc
nhấn Ctrl F3 để xem name
số liệu lớn có thể nó không chạy nổi
chúc năm mới ve vủi...............heheheheh

hoamattroicoi · 17/2/15

Hoặc không thích name như bạn Let'Gâu Gâu thì dùng công thức này tại cột F2 rùi copy xuống :

PHP:

=IF(COUNTIFS($C$2:$C2,C2,$E$2:$E2,E2,$B$2:$B2,B2)=1,LARGE(INDEX($D$2:$D$32*($C$2:$C$32=C2)*($E$2:$E$32=E2)*($B$2:$B$32=B2),0),1),0)

Và tỉnh tổng bằng SUMIFS.

(Cũng học cách trình bày cẩn thận như ai , }}}}}

)

khuongvietphong · 17/2/15

Let'GâuGâu đã viết:
bạn phải viết tiếng việt có dấu nha, đó là nội quy
============
thuc lam bẳng cthuc
nhấn Ctrl F3 để xem name
số liệu lớn có thể nó không chạy nổi
chúc năm mới ve vủi...............heheheheh

Cảm ơn bạn Let'GâuGâu đã nhắc nhở, tại lúc đó mình hơi vội, giờ mình đã sửa lại tất cả các bài không có dấu thành có dấu hết rồi.

khuongvietphong · 17/2/15

Cảm ơn tất cả mọi người đã giúp đỡ mình bài tập này. Xin chúc các bạn bước sang năm mới có thật nhiều sức khỏe nhiều niềm vui và gặp nhiều may mắn. Chúc các thành viên của diễn đàn GPE một năm mới nhiều thành công. HAPPY NEW YEAR

Hoàng Trọng Nghĩa · 21/2/15

hoamattroicoi đã viết:

Lâu rùi mình không viết code, bạn cũng có thể dùng thêm code này nhé :

PHP:

Function TinhTong(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4(), dArr()
Dim i As Long, kK As Long, k As Long, x As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value

ReDim dArr(1 To UBound(sArr1))
For i = 1 To UBound(sArr1, 1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            k = k + 1
            Dic.Add sArr4(i, 1), k
            dArr(k) = sArr3(i, 1)
            kQ = kQ + dArr(k)
        Else
            kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > dArr(kK) Then
            
                kQ = kQ + sArr3(i, 1) - dArr(kK)
                dArr(kK) = sArr3(i, 1)
        
            End If
        End If
    End If
Next
TinhTong = kQ
Set Dic = Nothing
End Function

Hoặc code này, ngắn hơn chút :

PHP:

Function TinhTong2(Rng1 As Range, dK1, Rng2 As Range, dK2, Rng3, ngAY As Range)
Dim sArr1(), sArr2(), sArr3(), kQ, sArr4()
Dim i As Long, kK As Double
Dim Dic As Object
Set Dic = CreateObject("scripting.dictionary")
sArr1 = Rng1.Value: sArr2 = Rng2.Value: sArr3 = Rng3.Value: sArr4 = ngAY.Value
kQ = 0
For i = 1 To UBound(sArr1)
    If sArr1(i, 1) = dK1 And sArr2(i, 1) = dK2 Then
        If Not Dic.exists(sArr4(i, 1)) Then
            Dic.Add sArr4(i, 1), sArr3(i, 1)
            kQ = kQ + sArr3(i, 1)
        Else
        kK = Dic.Item(sArr4(i, 1))
            If sArr3(i, 1) > kK Then
                kQ = kQ + sArr3(i, 1) - kK
                Dic.Item(sArr4(i, 1)) = sArr3(i, 1)
            End If
        End If
    End If
Next
TinhTong2 = kQ
Set Dic = Nothing
End Function

Chi tiết file đính kèm.

Đêm nay trằn trọc ngủ không được, nhớ lại cái bài này để ru ngủ mình được không! Thử không dùng cái DIT xem có ra kết quả không nhỉ!

Mã:

Function NghiaDepTrai(ByVal rngData, ByVal strTram As String, ByVal sglGia As Single) As Single
    Dim arrData, mDate
    arrData = rngData
    If Not IsArray(arrData) Then Exit Function
    Dim Itm As Single
    Dim arrGio(), arrNgay()
    Dim d As Long, i As Long, n As Long
    For d = 1 To UBound(arrData)
        If arrData(d, 2) = strTram And arrData(d, 4) = sglGia Then
            n = n + 1
            ReDim Preserve arrNgay(1 To n), arrGio(1 To n)
            arrNgay(n) = arrData(d, 1)
            arrGio(n) = arrData(d, 3)
        End If
    Next
    If n Then
        For d = 1 To n
            mDate = arrNgay(d): Itm = 0
            If mDate > 0 Then
                For i = d To n
                    If arrNgay(i) = mDate Then
                        arrNgay(i) = 0
                        If Itm < arrGio(i) Then Itm = arrGio(i)
                    End If
                Next
            End If
            NghiaDepTrai = NghiaDepTrai + Itm
        Next
    End If
End Function

Test với công thức:

Mã:

=NghiaDepTrai([COLOR=#0000cd]$B$2:$E$32[/COLOR],H3,I3)

khuongvietphong · 21/2/15

Hoàng Trọng Nghĩa đã viết:

Đêm nay trằn trọc ngủ không được, nhớ lại cái bài này để ru ngủ mình được không! Thử không dùng cái DIT xem có ra kết quả không nhỉ!

Mã:

Function NghiaDepTrai(ByVal rngData, ByVal strTram As String, ByVal sglGia As Single) As Single
    Dim arrData, mDate
    arrData = rngData
    If Not IsArray(arrData) Then Exit Function
    Dim Itm As Single
    Dim arrGio(), arrNgay()
    Dim d As Long, i As Long, n As Long
    For d = 1 To UBound(arrData)
        If arrData(d, 2) = strTram And arrData(d, 4) = sglGia Then
            n = n + 1
            ReDim Preserve arrNgay(1 To n), arrGio(1 To n)
            arrNgay(n) = arrData(d, 1)
            arrGio(n) = arrData(d, 3)
        End If
    Next
    If n Then
        For d = 1 To n
            mDate = arrNgay(d): Itm = 0
            If mDate > 0 Then
                For i = d To n
                    If arrNgay(i) = mDate Then
                        arrNgay(i) = 0
                        If Itm < arrGio(i) Then Itm = arrGio(i)
                    End If
                Next
            End If
            NghiaDepTrai = NghiaDepTrai + Itm
        Next
    End If
End Function

Test với công thức:

Mã:

=NghiaDepTrai([COLOR=#0000cd]$B$2:$E$32[/COLOR],H3,I3)

Cảm ơn anh Trọng Nghĩa. Chúc anh năm mới nhiều niềm vui và may mắn.

Làm sao để lấy giá trị lớn nhất trong cùng một ngày.

khuongvietphong

Be all you can be !

File đính kèm

SA_DQ

/(hông là gì!

File đính kèm

khuongvietphong

Be all you can be !

hoamattroicoi

Thành viên gắn bó

File đính kèm

khuongvietphong

Be all you can be !

Let'GâuGâu

Thành viên mới

File đính kèm

hoamattroicoi

Thành viên gắn bó

File đính kèm

khuongvietphong

Be all you can be !

khuongvietphong

Be all you can be !

Hoàng Trọng Nghĩa

Chuyên gia GPE

khuongvietphong

Be all you can be !

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