Lọc theo 2 điều kiện.

[ThuNghi]

Lọc theo 2 điều kiện - tạo sổ cái từ NKC
Tôi có 1 bài toán trích lọc theo 2 điều kiện, cụ thể như sau:
Data gồm 3 cột 08, 09 và 10
Tôi muốn xét theo điều kiện cột 08, 09 = điều kiện cho trước thì sẽ lấy dòng đó.
Cụ thể như tạo sổ cái từ Data.
Cot08 và Cot09 là text
Cot10 là number.

Cot08---Cot09---Cot10 (số tiền)
xxxx------yyyy-----Z
zzzz------xxxx-----T
ttttt------xxxx-----M

Tôi muốn lọc ra như sau với điều kiện ShTK="xxxx"

CotA----ST1----ST2
yyyy-----Z------0
zzzz------0-------T
tttt-------0-------M

Tôi đã tạo các code theo các hướng và có cột đếm time.
1/ Array
2/ Find
3/ AdFi
4/ ADO

Nhờ các bạn hoàn thiện các code trên và nếu có phương pháp nào tối ưu hơn thì các bạn hướng dẫn.

Các bạn nhớ "nhan ban" với sh B1 là số lần nhân bản thì sẽ thấy sự khác biệt. Tôi làm vậy cho nhẹ file nhằm giúp các bạn dễ down.
Xin cám ơn.

 

[ThuNghi]

Bác PTM, anh Sealand và các anh chị hỗ trợ em với.
Hay là xem giúp em code TaoSoCai01 để em hoàn thiện thêm phần lấy các cột khác (soCt, ngayHT...) theo tiêu chí trên.

Const colTKNo As Long = 8, colTKCo As Long = 9, colSTps As Long = 10
Dim endR As Long, i As Long, SoLan As Long, k As Long, s As Long
Dim arrTK(), arrST(), shTK As String
Dim T
Dim rngNo As Range, rngCo As Range, rngSt As Range
Dim wf As WorksheetFunction
Sub Begin()
Set wf = WorksheetFunction
With Sheets("Data")
  .AutoFilterMode = False
  endR = .Cells(65000, colTKNo).End(xlUp).Row
  shTK = .Cells(3, 12)
  Set rngNo = .Range(.Cells(3, colTKNo), .Cells(endR, colTKNo))
  Set rngCo = rngNo.Offset(, 1)
  Set rngSt = rngNo.Offset(, 2)
End With
End Sub
Sub endCode()
Set rngNo = Nothing
Set rngCo = Nothing
Set rngSt = Nothing
Set wf = Nothing
End Sub
Sub xoaSocai()
With Sheets("SoCai")
  .Range("G10:I65000").ClearContents
End With
End Sub
Sub TaoSoCai01()
T = Timer
Begin
Dim rngData As Range
s = 0
Dim arrKQ(1 To 65000, 1 To 3)
Set rngData = Union(rngNo, rngCo)
arrTK = rngData.Value
arrST = rngSt.Value
SoLan = WorksheetFunction.CountIf(rngData, shTK)
For i = 1 To UBound(arrTK)
  If s > SoLan Then GoTo bien
  If arrTK(i, 1) = shTK Then
    s = s + 1
    arrKQ(s, 1) = arrTK(i, 2)
    arrKQ(s, 2) = arrST(i, 1)
  End If
  If arrTK(i, 2) = shTK Then
    s = s + 1
    arrKQ(s, 1) = arrTK(i, 1)
    arrKQ(s, 3) = arrST(i, 1)
  End If
Next
bien:
xoaSocai
If s = 0 Then Exit Sub
With Sheets("SoCai")
  With .Range("G10")
    .Resize(s, 3) = arrKQ
  End With
End With
Set rngData = Nothing
Erase arrTK, arrKQ
With Sheets("Data")
  .[N3] = Timer - T
End With
End Sub

Cám ơn rất là nhiều. Xin hậu tạ 1 chầu Ken + mực khô Nha Trang + ...

 

[haonlh]

Tôi nghĩ đoạn mã lệnh sau

With Sheets("SoCai")
With .Range("G10")
.Resize(s, 3) = arrKQ
End With
End With

có thể thay là

Sheets("SoCai").Range("G10").Resize(s, 3) = arrKQ

có được không. Tôi có thử. Hy vọng sẽ ngắn mã nguồn

 

[ptm0412]

Trong quá trình thực hiện ThuNghi đã hỏi mình, và làm đúng y như vậy rồi còn gì. (Vụ gợi ý dùng countif giới hạn số lần lặp đó. Nhất là Arr 3 cột)
Test dữ liệu 65000 dòng ra kết quả với thời gian dưới 1 giây là OK thôi. Bia thì nhận, mực thì bị dị ứng, xin đổi món khác. Cái "+..." là kí rì vậy?