Cần hỗ trợ hàm VLookup tìm giá trị mới nhất (4 người xem)

thanhtaiteo · 1/4/18

HieuCD đã viết:
Mình không dùng hàm Sumproduct vì nó khá nặng khi dữ liệu nhiều
Dữ liệu thời gian rất khó chịu, mình cũng không biết lúc nào nó bị lổi như trong trường hợp nầy
Thời gian trong file tính tới giây, 1 giây = 1/24/60/60 = 0.0000116, nên mình cộng thêm 0.0000001 (trừ hao 7 số lẻ, thực ra chỉ cần 6 số lẻ 0.000001), không tăng thêm giây nào nhưng lớn hơn giá trị gốc để khử lổi điều kiện J$5:J$28, ">"&

Em chân thành cám ơn sự hỗ trợ từ bác dazkangel, bác Ba Tê, Bác HieuCD

Em xin Summary lại vấn đề như sau ạ

Ba Tê · 1/4/18

thanhtaiteo đã viết:
Em chân thành cám ơn sự hỗ trợ từ bác dazkangel, bác Ba Tê, Bác HieuCD

Em xin Summary lại vấn đề như sau ạ

View attachment 193220

PHP:

Public Sub GPE()
Dim Dic As Object, sArr(), tArr(), Tem As String
Dim I As Long, K As Long, R As Long, Rws As Long
Set Dic = CreateObject("Scripting.Dictionary")
    sArr = Sheets("App total").Range("G3", Sheets("App total").Range("G3").End(xlDown)).Resize(, 52).Value
    R = UBound(sArr)
    ReDim tArr(1 To R, 1 To 4)
    For I = 1 To R
        Tem = sArr(I, 1)
        If Not Dic.exists(Tem) Then
            K = K + 1
            Dic.Item(Tem) = K
            tArr(K, 1) = sArr(I, 1)
            tArr(K, 2) = sArr(I, 45)
            tArr(K, 3) = sArr(I, 15)
            tArr(K, 4) = sArr(I, 52)
        Else
            Rws = Dic.Item(Tem)
            If sArr(I, 45) > tArr(Rws, 2) Then
                tArr(Rws, 2) = sArr(I, 45)
                tArr(Rws, 3) = sArr(I, 15)
                tArr(Rws, 4) = sArr(I, 52)
            End If
        End If
    Next I
    '-------------------------------------------'
With Sheets("Details")
    sArr = .Range("cq2", .Range("cq2").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
    ReDim Arr1(1 To R, 1 To 1)
    ReDim Arr2(1 To R, 1 To 1)
    For I = 1 To R
        Tem = IIf(sArr(I, 3) <> Empty, sArr(I, 3), sArr(I, 1))
        If Dic.exists(Tem) Then
            Arr1(I, 1) = tArr(Dic.Item(Tem), 3)
            Arr2(I, 1) = tArr(Dic.Item(Tem), 4)
        Else
            Arr1(I, 1) = "Not Created App"
        End If
    Next I
    .Range("fv2").Resize(R) = Arr1
    .Range("fy2").Resize(R) = Arr2
End With
Set Dic = Nothing
End Sub

HieuCD · 1/4/18

thanhtaiteo đã viết:
Em chân thành cám ơn sự hỗ trợ từ bác dazkangel, bác Ba Tê, Bác HieuCD

Em xin Summary lại vấn đề như sau ạ

View attachment 193220

Mã:

Sub Result()
  Dim dID As Variant, dTime As Variant, dRes1 As Variant, dRes2 As Variant
  Dim ID1 As Variant, ID2 As Variant, Res1 As Variant, Res2 As Variant
  Dim i As Long, ik As Long, dsR As Long, sR As Long, key As String
 
  With Sheets("App total")
    dsR = .Range("G" & Rows.Count).End(xlUp).Row - 2
    If dsR < 1 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    dID = .Range("G3").Resize(dsR).Value
    dTime = .Range("AY3").Resize(dsR).Value
    dRes1 = .Range("U3").Resize(dsR).Value
    dRes2 = .Range("BF3").Resize(dsR).Value
  End With
 
  With Sheets("Details")
    sR = .Range("CQ" & Rows.Count).End(xlUp).Row - 1
    If sR < 1 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    ID1 = .Range("CQ2").Resize(sR).Value
    ID2 = .Range("CS2").Resize(sR).Value
  End With
  ReDim Res1(1 To sR, 1 To 1)
  ReDim Res2(1 To sR, 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To dsR
      key = dID(i, 1)
      If Not .exists(key) Then .Add key, i Else If dTime(i, 1) > dTime(.Item(key), 1) Then .Item(key) = i
    Next i
  
    For i = 1 To sR
      If ID2(i, 1) = Empty Then key = ID1(i, 1) Else key = ID2(i, 1)
      ik = .Item(key)
      If ik Then
        Res1(i, 1) = dRes1(ik, 1)
        Res2(i, 1) = dRes2(ik, 1)
      Else
        Res1(i, 1) = "Not Created App"
      End If
    Next i
  End With
 
  With Sheets("Details")
    .Range("FV2").Resize(sR) = Res1
    .Range("FY2").Resize(sR) = Res2
  End With
End Sub

dazkangel · 1/4/18

HieuCD đã viết:

Mã:

Sub Result()
  Dim dID As Variant, dTime As Variant, dRes1 As Variant, dRes2 As Variant
  Dim ID1 As Variant, ID2 As Variant, Res1 As Variant, Res2 As Variant
  Dim i As Long, ik As Long, dsR As Long, sR As Long, key As String
 
  With Sheets("App total")
    dsR = .Range("G" & Rows.Count).End(xlUp).Row - 2
    If dsR < 1 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    dID = .Range("G3").Resize(dsR).Value
    dTime = .Range("AY3").Resize(dsR).Value
    dRes1 = .Range("U3").Resize(dsR).Value
    dRes2 = .Range("BF3").Resize(dsR).Value
  End With
 
  With Sheets("Details")
    sR = .Range("CQ" & Rows.Count).End(xlUp).Row - 1
    If sR < 1 Then MsgBox ("Khong co du lieu, thoat chuong trinh"): Exit Sub
    ID1 = .Range("CQ2").Resize(sR).Value
    ID2 = .Range("CS2").Resize(sR).Value
  End With
  ReDim Res1(1 To sR, 1 To 1)
  ReDim Res2(1 To sR, 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For i = 1 To dsR
      key = dID(i, 1)
      If Not .exists(key) Then .Add key, i Else If dTime(i, 1) > dTime(.Item(key), 1) Then .Item(key) = i
    Next i
 
    For i = 1 To sR
      If ID2(i, 1) = Empty Then key = ID1(i, 1) Else key = ID2(i, 1)
      ik = .Item(key)
      If ik Then
        Res1(i, 1) = dRes1(ik, 1)
        Res2(i, 1) = dRes2(ik, 1)
      Else
        Res1(i, 1) = "Not Created App"
      End If
    Next i
  End With
 
  With Sheets("Details")
    .Range("FV2").Resize(sR) = Res1
    .Range("FY2").Resize(sR) = Res2
  End With
End Sub

Vì không biết gì về code nên chế bằng pivot, anh xem kết quả đúng không nha:

HieuCD · 1/4/18

dazkangel đã viết:
Vì không biết gì về code nên chế bằng pivot, anh xem kết quả đúng không nha:

Mình nghĩ bài nầy không dùng Pivot được do yêu cầu phức tạp
- Lấy tất cả các dòng theo sheet detail
- Lấy ID đã điều chỉnh và mới nhất ở 2 sheet
Pivot của bạn chỉ lấy tất cả các dòng của Sheets("App total") và xếp lại cột
Code VBA căn bản không khó hơn công thức Excel, bạn tập viết từ từ, sẽ nhớ các lệnh và quen cách tư duy lập trình, chia quá trình xử lý theo từng bước (tương tự như cột phụ excel)
Chúc bạn 1 ngày vui

thanhtaiteo · 1/4/18

HieuCD đã viết:
Mình nghĩ bài nầy không dùng Pivot được do yêu cầu phức tạp
- Lấy tất cả các dòng theo sheet detail
- Lấy ID đã điều chỉnh và mới nhất ở 2 sheet
Pivot của bạn chỉ lấy tất cả các dòng của Sheets("App total") và xếp lại cột
Code VBA căn bản không khó hơn công thức Excel, bạn tập viết từ từ, sẽ nhớ các lệnh và quen cách tư duy lập trình, chia quá trình xử lý theo từng bước (tương tự như cột phụ excel)
Chúc bạn 1 ngày vui

Dạ em xin update lại thông tin như sau ạ .

Cách Pivot của bác dazkangle làm cho em có thêm 1 cách để giải quyết các vấn đề khác nữa ạ . Cám ơn bác .

Áp dụng theo 3 cách của Bác Dazkangel, bác HieuCD, bác Ba Tê thì cho kết quả như sau :

Trong kết quả của hàng trăm ngàn dòng thì lồi ra 5 case bị lệch result 1 của bác dankangel và bác HieuCD .

Em check tay thì kết quả của bác HieuCD có thể giúp em trọn vẹn cả đôi đường .

Vấn đề đã được giải quyết, em chân thành cám ơn 3 bác đã hỗ trợ cho em những ngày qua .

Em xin tri ân, để tỏ lòng biết ơn vì đã hỗ trợ, 3 bác cho em xin số điện thoại ạ . Thank you very much !!!!!

Ba Tê · 2/4/18

thanhtaiteo đã viết:
Dạ em xin update lại thông tin như sau ạ .

Cách Pivot của bác dazkangle làm cho em có thêm 1 cách để giải quyết các vấn đề khác nữa ạ . Cám ơn bác .

Áp dụng theo 3 cách của Bác Dazkangel, bác HieuCD, bác Ba Tê thì cho kết quả như sau :

Trong kết quả của hàng trăm ngàn dòng thì lồi ra 5 case bị lệch result 1 của bác dankangel và bác HieuCD .

Em check tay thì kết quả của bác HieuCD có thể giúp em trọn vẹn cả đôi đường .

Vấn đề đã được giải quyết, em chân thành cám ơn 3 bác đã hỗ trợ cho em những ngày qua .

Em xin tri ân, để tỏ lòng biết ơn vì đã hỗ trợ, 3 bác cho em xin số điện thoại ạ . Thank you very much !!!!!

View attachment 193242

Do bạn ẩn cột nên tôi bị nhầm, đoạn này phải như vầy:
(Đã sửa lại bài #22)

PHP:

With Sheets("Details")
    sArr = .Range("cq2", .Range("cq2").End(xlDown)).Resize(, 3).Value
    R = UBound(sArr)
    ReDim Arr1(1 To R, 1 To 1)
    ReDim Arr2(1 To R, 1 To 1)
    For i = 1 To R
        Tem = IIf(sArr(i, 3) <> Empty, sArr(i, 3), sArr(i, 1))'<------------'
        If Dic.exists(Tem) Then
            Arr1(i, 1) = tArr(Dic.Item(Tem), 3)
            Arr2(i, 1) = tArr(Dic.Item(Tem), 4)
        Else
            Arr1(i, 1) = "Not Created App"
        End If
    Next i
    .Range("fv2").Resize(R) = Arr1
    .Range("fy2").Resize(R) = Arr2
End With

dazkangel · 2/4/18

thanhtaiteo đã viết:
Dạ em xin update lại thông tin như sau ạ .

Cách Pivot của bác dazkangle làm cho em có thêm 1 cách để giải quyết các vấn đề khác nữa ạ . Cám ơn bác .

Áp dụng theo 3 cách của Bác Dazkangel, bác HieuCD, bác Ba Tê thì cho kết quả như sau :

Trong kết quả của hàng trăm ngàn dòng thì lồi ra 5 case bị lệch result 1 của bác dankangel và bác HieuCD .

Em check tay thì kết quả của bác HieuCD có thể giúp em trọn vẹn cả đôi đường .

Vấn đề đã được giải quyết, em chân thành cám ơn 3 bác đã hỗ trợ cho em những ngày qua .

Em xin tri ân, để tỏ lòng biết ơn vì đã hỗ trợ, 3 bác cho em xin số điện thoại ạ . Thank you very much !!!!!

View attachment 193242

Với dữ liệu từ vài ngàn dòng thôi đã đuối rồi. Nên đành xài VBA vậy, cảm ơn trên đây là vui rồi bạn.

Cần hỗ trợ hàm VLookup tìm giá trị mới nhất (4 người xem)

Người dùng đang xem chủ đề này

thanhtaiteo

Thành viên mới

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

HieuCD

Chuyên gia GPE

dazkangel

<New Horizons>

File đính kèm

HieuCD

Chuyên gia GPE

thanhtaiteo

Thành viên mới

File đính kèm

Ba Tê

Cạo Rồi Khỏi Gội

dazkangel

<New Horizons>

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

Đếm ngược thời gian