Dùng Phương thức (Code) nào để thay thế cho tổng 2 hàm Vlookup (1 người xem)

[huy vu]

Chào anh/chị GPE, em có câu hỏi như nêu tại tiêu đề, chi tiết cũng minh họa tại File đính kèm.
Mong các thành viên giúp.

 

[ndu96081631]

Chào anh/chị GPE, em có câu hỏi như nêu tại tiêu đề, chi tiết cũng minh họa tại File đính kèm.
Mong các thành viên giúp.

Tôi thấy dùng SUMIF cũng được mà:

=SUMPRODUCT(SUMIF($G$2:$G$21,$A2:$B2,$H$2:$H$21))

 

[SA_DQ]

Tại [C2] bạn có thể xài công thức này:

=VLOOKUP(A2,$G$2:$H$21,2,0)+IF(B2="",0,VLOOKUP(B2,$G$2:$H$21,2,0))
​

 

[huy vu]

Đây là data giả lập, thuc te Dữ liệu nhiều nên em muốn dùng code a.

 

[SA_DQ]

Bạn gán vùng tra bảng có tên là 'BTra' & xài macro sau

Option Explicit
Sub VLooKupTheoBangTra()
  Dim J As Long, Rws As Long
  Dim WF As Object
    
  Rws = [A1].CurrentRegion.Find("*", [A1], , , xlByRows, xlPrevious).Row
  Set WF = Application.WorksheetFunction
  For J = 2 To Rws
    With Cells(J, "A")
        If .Value <> "" And .Offset(, 1).Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Value, Range("BTra"), 2, False) _
                + WF.VLookup(.Offset(, 1).Value, Range("BTra"), 2, False)
        ElseIf .Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Value, Range("BTra"), 2, False)
        ElseIf .Offset(, 1).Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Offset(, 1).Value, Range("BTra"), 2, False)
        End If
    End With
  Next J
End Sub

 

[ndu96081631]

Option Explicit
Sub VLooKupTheoBangTra()
  Dim J As Long, Rws As Long
  Dim WF As Object
    
  Rws = [A1].CurrentRegion.Find("*", [A1], , , xlByRows, xlPrevious).Row
  Set WF = Application.WorksheetFunction
  For J = 2 To Rws
    With Cells(J, "A")
        If .Value <> "" And .Offset(, 1).Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Value, Range("BTra"), 2, False) _
                + WF.VLookup(.Offset(, 1).Value, Range("BTra"), 2, False)
        ElseIf .Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Value, Range("BTra"), 2, False)
        ElseIf .Offset(, 1).Value <> "" Then
            .Offset(, 2).Value = WF.VLookup(.Offset(, 1).Value, Range("BTra"), 2, False)
        End If
    End With
  Next J
End Sub

Em thấy dùng Find Method là đủ rồi (tìm được ta offset qua để lấy kết quả) chứ đâu cần phải VLOOKUP hả sư phụ
Tức là Find 2 lần, lấy 2 kết quả ấy cộng lại với nhau. Kiểu vầy nè sư phụ:

Sub Main()
  Dim rng As Range, rFind As Range, cel As Range
  Dim dRes1 As Double, dRes2 As Double
  Application.ScreenUpdating = False
  With Sheets("1")
    Set rng = .Range("G2:G20000")
    For Each cel In .Range("C2:C20000")
      If cel.Offset(, -1).Value <> Empty Or cel.Offset(, -2).Value <> Empty Then
        Set rFind = rng.Find(cel.Offset(, -1).Value, , xlValues, xlWhole)
        If Not rFind Is Nothing Then dRes1 = rFind.Offset(, 1).Value
        Set rFind = rng.Find(cel.Offset(, -2).Value, , xlValues, xlWhole)
        If Not rFind Is Nothing Then dRes2 = rFind.Offset(, 1).Value
        cel.Value = dRes1 + dRes2
      End If
    Next
  End With
  Application.ScreenUpdating = True
End Sub

Code không nhanh bằng cách dùng mảng nhưng tạm chấp nhận được cho 20000 dòng dữ liệu

 

[TrungChinhs]

Bạn thử xem, cái này cũng cho kết quả nhưng không biết nhanh chậm thế nào.

Sub Macro1()
    Application.ScreenUpdating = False
    On Error Resume Next
    Set Rng = [g1:g65000]
    For Each cls In Range("a2:a" & [a65000].End(3).Row)
        cls(1, 3) = Rng.Find(cls, , , 2)(1, 2) + Rng.Find(cls(1, 2), , , 2)(1, 2)
    Next
    Application.ScreenUpdating = True
End Sub

 

[Quang_Hải]

Chào anh/chị GPE, em có câu hỏi như nêu tại tiêu đề, chi tiết cũng minh họa tại File đính kèm.
Mong các thành viên giúp.

Thử cách này. Hy vọng là cột A của bạn luôn dài hơn cột B

Sub Cong()
Dim Arr(), i, Dic As Object
Set Dic = CreateObject("scripting.dictionary")
Arr = Range([G2], [H65536].End(3)).Value
For i = 1 To UBound(Arr)
    Dic(Arr(i, 1)) = Arr(i, 2)
Next
Arr = Range([A2], [A65536].End(3)).Resize(, 2).Value
ReDim Preserve Arr(1 To UBound(Arr), 1 To 3)
For i = 1 To UBound(Arr)
    Arr(i, 3) = Dic.Item(Arr(i, 1)) + Dic.Item(Arr(i, 2))
Next
[A2].Resize(i - 1, 3) = Arr
End Sub

 

[huy vu]

Em thấy dùng Find Method là đủ rồi (tìm được ta offset qua để lấy kết quả) chứ đâu cần phải VLOOKUP hả sư phụ
Tức là Find 2 lần, lấy 2 kết quả ấy cộng lại với nhau. Kiểu vầy nè sư phụ:

Sub Main()
  Dim rng As Range, rFind As Range, cel As Range
  Dim dRes1 As Double, dRes2 As Double
  Application.ScreenUpdating = False
  With Sheets("1")
    Set rng = .Range("G2:G20000")
    For Each cel In .Range("C2:C20000")
      If cel.Offset(, -1).Value <> Empty Or cel.Offset(, -2).Value <> Empty Then
        Set rFind = rng.Find(cel.Offset(, -1).Value, , xlValues, xlWhole)
        If Not rFind Is Nothing Then dRes1 = rFind.Offset(, 1).Value
        Set rFind = rng.Find(cel.Offset(, -2).Value, , xlValues, xlWhole)
        If Not rFind Is Nothing Then dRes2 = rFind.Offset(, 1).Value
        cel.Value = dRes1 + dRes2
      End If
    Next
  End With
  Application.ScreenUpdating = True
End Sub

Code không nhanh bằng cách dùng mảng nhưng tạm chấp nhận được cho 20000 dòng dữ liệu

Loay toay xoay 1 hồi theo cách của anh NDU cũng phải ra:

Sub DoanhThu()
    Dim Rng As Range, rFind As Range, Cel As Range
    Dim dRes1 As Double, dRes2 As Double
    Application.ScreenUpdating = False
    With Sheets("DATA")
        Set Rng = Sheets("LuyKe").Range("A2:A10000")
        For Each Cel In .Range("AD7:AD10000")
            If Cel.Offset(, -22).Value <> Empty Or Cel.Offset(, -20).Value <> Empty Then
                Set rFind = Rng.Find(Cel.Offset(, -22).Value, , , 1)
                If Not rFind Is Nothing Then dRes1 = rFind.Offset(, 2).Value
                Set rFind = Rng.Find(Cel.Offset(, -20).Value, , , 1)
                If Not rFind Is Nothing Then dRes2 = rFind.Offset(, 2).Value
                Cel.Value = dRes1 + dRes2
            End If
        Next
    End With
    Application.ScreenUpdating = True
End Sub

Nghiên cứu thêm code của anh QuangHai xem sao, vì nghe nói Dic cho tốc độ nhanh lắm.