Hỗ trợ tối ưu code hàm Lọc dữ liệu theo điều kiện (1 người xem)

[NHG]

Hi các bạn
Mình tạo một hàm để lọc dữ liệu theo điều kiện với cú phát
Filter(Điều kiện; Cột điều kiện; Cột Kết quả; Số thứ tự)

ý tưởng là như này:
Gán cột điều kiện thành mảng có nhiều hàng và 1 cột; mở rộng mảng đó ra thành nhiều hàng và 2 cột
Duyệt điều kiện trong mảng; nếu trùng thì cột thứ 2 của mảng sẽ trả về số thứ tự của các ô thỏa mãn điều kiện
Hàm Filter sẽ so sánh số thứ tự trong đối số; nếu khớp số thứ tự trong mảng thì trả về kết quả
Nhưng do mình dùng nhiều vòng lặp quá nên công thức chạy rất ì ạch; dưới 5000 dòng dữ liệu thì ko sao, chứ nhiều hơn là ngồi chơi xơi nước ngay
Các bạn xem giúp m nhé


Function Filter_DieuKien_CotDieuKien_CotKetQua_STT(ByVal dk As String, ByVal vungdk As Range, ByVal mang As Range, ByVal STT As String)
Dim Dic As Object, arr(), sArray, i, j As Long, Item, Tmp

sArray = mang.Value
arr = vungdk.Value
ReDim Preserve sArray(1 To UBound(sArray), 1 To 2)
ReDim daura(1 To UBound(arr), 1 To 2)

For i = 1 To UBound(arr)
If UCase(arr(i, 1)) Like UCase(dk) Then
j = j + 1
daura(j, 1) = sArray(i, 1)
daura(j, 2) = j
End If
Next

For i = 1 To UBound(arr)
If STT = daura(i, 2) Then
kq = daura(i, 1)
End If
Next

Filter_DieuKien_CotDieuKien_CotKetQua_STT = kq
End Function

 

[giaiphap]

Hi các bạn
Mình tạo một hàm để lọc dữ liệu theo điều kiện với cú phát
Filter(Điều kiện; Cột điều kiện; Cột Kết quả; Số thứ tự)
View attachment 237781
ý tưởng là như này:
Gán cột điều kiện thành mảng có nhiều hàng và 1 cột; mở rộng mảng đó ra thành nhiều hàng và 2 cột
Duyệt điều kiện trong mảng; nếu trùng thì cột thứ 2 của mảng sẽ trả về số thứ tự của các ô thỏa mãn điều kiện
Hàm Filter sẽ so sánh số thứ tự trong đối số; nếu khớp số thứ tự trong mảng thì trả về kết quả
Nhưng do mình dùng nhiều vòng lặp quá nên công thức chạy rất ì ạch; dưới 5000 dòng dữ liệu thì ko sao, chứ nhiều hơn là ngồi chơi xơi nước ngay
Các bạn xem giúp m nhé


Function Filter_DieuKien_CotDieuKien_CotKetQua_STT(ByVal dk As String, ByVal vungdk As Range, ByVal mang As Range, ByVal STT As String)
Dim Dic As Object, arr(), sArray, i, j As Long, Item, Tmp

sArray = mang.Value
arr = vungdk.Value
ReDim Preserve sArray(1 To UBound(sArray), 1 To 2)
ReDim daura(1 To UBound(arr), 1 To 2)

For i = 1 To UBound(arr)
If UCase(arr(i, 1)) Like UCase(dk) Then
j = j + 1
daura(j, 1) = sArray(i, 1)
daura(j, 2) = j
End If
Next

For i = 1 To UBound(arr)
If STT = daura(i, 2) Then
kq = daura(i, 1)
End If
Next

Filter_DieuKien_CotDieuKien_CotKetQua_STT = kq
End Function

Thử sửa lại thế này xem tốc độ có khá hơn chút nào không.

Function Filter_DieuKien_CotDieuKien_CotKetQua_STT(ByVal dk As String, ByVal vungdk As Range, ByVal mang As Range, ByVal STT As String)
  Dim arr, sArray, i As Long, j As Long
  sArray = mang.Value
  arr = vungdk.Value
  If Application.WorksheetFunction.CountIf(vungdk, dk) < STT Then
    Filter_DieuKien_CotDieuKien_CotKetQua_STT = 0
    Exit Function
  Else
    For i = 1 To UBound(arr)
      If UCase(arr(i, 1)) Like UCase(dk) Then
          j = j + 1
          If j = STT Then
              Filter_DieuKien_CotDieuKien_CotKetQua_STT = sArray(i, 1)
              Exit Function
          End If
      End If
    Next
  End If
End Function

 

[phulien1902]

Dùng Sub, không dùng Function có được không bạn?

Sub Test()
    Dim a(), b(), i As Long, k As Long, dk, LR, j
    With Sheet1
        a = .Range("A11", .Range("A65000").End(3)).Resize(, 7).Value: LR = UBound(a)
    End With
    dk = Sheet1.Range("L8"): ReDim b(1 To LR, 1 To 7)
    With Sheet1
        For i = 1 To LR
            If a(i, 2) = dk Then
                k = k + 1: b(k, 1) = k: For j = 2 To 7: b(k, j) = a(i, j): Next j
            End If
        Next i
        Sheet1.Range("K11:Q6000").ClearContents
        If k Then
            With Sheet1
                .Range("K11").Resize(k, 7) = b
            End With
        End If
    End With
End Sub

 

[be_09]

Hi các bạn
Mình tạo một hàm để lọc dữ liệu theo điều kiện với cú phát
Filter(Điều kiện; Cột điều kiện; Cột Kết quả; Số thứ tự)
ý tưởng là như này:
Gán cột điều kiện thành mảng có nhiều hàng và 1 cột; mở rộng mảng đó ra thành nhiều hàng và 2 cột
Duyệt điều kiện trong mảng; nếu trùng thì cột thứ 2 của mảng sẽ trả về số thứ tự của các ô thỏa mãn điều kiện
Hàm Filter sẽ so sánh số thứ tự trong đối số; nếu khớp số thứ tự trong mảng thì trả về kết quả
Nhưng do mình dùng nhiều vòng lặp quá nên công thức chạy rất ì ạch; dưới 5000 dòng dữ liệu thì ko sao, chứ nhiều hơn là ngồi chơi xơi nước ngay
Các bạn xem giúp m nhé

Không hiểu, làm đại hên thì trúng.

 

[NHG]

Thử sửa lại thế này xem tốc độ có khá hơn chút nào không.

Function Filter_DieuKien_CotDieuKien_CotKetQua_STT(ByVal dk As String, ByVal vungdk As Range, ByVal mang As Range, ByVal STT As String)
  Dim arr, sArray, i As Long, j As Long
  sArray = mang.Value
  arr = vungdk.Value
  If Application.WorksheetFunction.CountIf(vungdk, dk) < STT Then
    Filter_DieuKien_CotDieuKien_CotKetQua_STT = 0
    Exit Function
  Else
    For i = 1 To UBound(arr)
      If UCase(arr(i, 1)) Like UCase(dk) Then
          j = j + 1
          If j = STT Then
              Filter_DieuKien_CotDieuKien_CotKetQua_STT = sArray(i, 1)
              Exit Function
          End If
      End If
    Next
  End If
End Function

Nhanh hơn tương đối bạn ạ, thank bạn

Bài đã được tự động gộp: 22/5/20

Dùng Sub, không dùng Function có được không bạn?

Sub Test()
    Dim a(), b(), i As Long, k As Long, dk, LR, j
    With Sheet1
        a = .Range("A11", .Range("A65000").End(3)).Resize(, 7).Value: LR = UBound(a)
    End With
    dk = Sheet1.Range("L8"): ReDim b(1 To LR, 1 To 7)
    With Sheet1
        For i = 1 To LR
            If a(i, 2) = dk Then
                k = k + 1: b(k, 1) = k: For j = 2 To 7: b(k, j) = a(i, j): Next j
            End If
        Next i
        Sheet1.Range("K11:Q6000").ClearContents
        If k Then
            With Sheet1
                .Range("K11").Resize(k, 7) = b
            End With
        End If
    End With
End Sub

Hii, mục tiêu là tạo hàm bạn ạ, tks bạn

Bài đã được tự động gộp: 22/5/20

Không hiểu, làm đại hên thì trúng.

Cám ơn bạn, mình thử tạo hàm