Nhờ giúp đỡ code VBA giải quyết các vấn đề lọc, tìm kiếm giá trị (vì sử dụng công thức bị chậm)

Chia sẻ bởi:hands

★★★★★

‹ Lấy dữ liệu từ nhiều vào 1... Xin mã VBA như hàm Vloopkup nhưng... ›

Quảng cáo

Chào anh chị ! em có file excel này nhờ anh chị viết giúp code ,

trong file excel em có ghi rõ các vấn đề nhờ anh chị giúp. anh chị nào viết chạy tốt sớm nhất rồi comment sđt để em hậu tạ ạ 🙂
-Ngoài ra em cũng mới biết VBA được 2 tháng , đang rất muốn học anh chị nào có lớp dạy hoặc biết chỗ nào dạy tốt chỉ giúp em ạ, em ở khu vực TP HCM, huyện Bình Chánh gần cuối đường Nguyễn Văn Linh ạ

Xong cái điều kiện 1.
Bạn xem.

Sub timkiem1()
Dim a As Long, b As Long, c As Long, i As Long, j As Long, k As Long
Dim arr, arr1
Dim dk As String, dks As String
Dim aT, T, aso()
With Sheets("danh sach tong")
     b = .Range("B" & Rows.Count).End(xlUp).Row
     If b < 3 Then MsgBox "khong co du lieu": Exit Sub
     arr = .Range("A4:P" & b).Value
     ReDim arr1(1 To UBound(arr, 1), 1 To 6)
End With
With Sheets("ket qua")
     T = Array(.Range("b3").Value, .Range("b4").Value, .Range("b5").Value)
     aT = Array(14, 15, 16)
     For i = LBound(T) To UBound(T)
         If T(i) <> Empty Then
            c = c + 1
            If dk = Empty Then
               dk = T(i)
            Else
               dk = dk & "#" & T(i)
            End If
          ReDim Preserve aso(1 To c)
           aso(c) = aT(i)
         End If
     Next i
For i = 1 To UBound(arr, 1)
    dks = Empty
    On Error Resume Next
    For k = LBound(aso) To UBound(aso)
        If dks = Empty Then
           dks = arr(i, aso(k))
        Else
           dks = dks & "#" & arr(i, aso(k))
        End If
    Next k
    If UCase(dk) = UCase(dks) Then
       a = a + 1
       arr1(a, 1) = a
       arr1(a, 2) = arr(i, 2)
       arr1(a, 3) = arr(i, 5)
       arr1(a, 4) = arr(i, 8)
       arr1(a, 5) = arr(i, 9)
       arr1(a, 6) = arr(i, 10)
     End If
Next i
c = .Range("E" & Rows.Count).End(xlUp).Row
If c > 2 Then .Range("D3:i" & c).ClearContents
If a Then .Range("D3").Resize(a, 6).Value = arr1
End With
End Sub

www.giaiphapexcel.com/diendan/threads/nh%E1%BB%9D-gi%C3%BAp-%C4%91%E1%BB%A1-code-vba-gi%E1%BA%A3i-quy%E1%BA%BFt-c%C3%A1c-v%E1%BA%A5n-%C4%91%E1%BB%81-l%E1%BB%8Dc-t%C3%ACm-ki%E1%BA%BFm-gi%C3%A1-tr%E1%BB%8B-v%C3%AC-s%E1%BB%AD-d%E1%BB%A5ng-c%C3%B4ng-th%E1%BB%A9c-b%E1%BB%8B-ch%E1%BA%ADm.139592/