Giúp đỡ code: Trích lọc dữ liệu có điều kiện (1 người xem)

[alexanderhuti]

Tôi có vấn đề này nhờ xin nhờ các anh/chị/em GPE giúp đỡ:

- Sheet "Dulieu" chứa thông tin khách hàng đã mua hàng, số tiền, mặt hàng,.....
"Dulieu" được cập nhật hàng ngày.

- Yêu cầu đặt ra là tại sheet "Trichloc": khi gõ từ khoá vào (ví dụ: coca cola) và chọn kiểu tìm kiếm (nghĩa là tìm kiếm theo tên khách hàng/ hay theo phân loại hàng/ hay theo mặt hàng/ theo trọng lượng/ theo số tiền/...)
thì chương trình sẽ lọc dữ liệu ở sheet "Dulieu" và copy vào sheet "Trichloc" theo các nội dung bắt đầu từ ô A5.

- Ghi chú: Khi tìm kiếm theo khách hàng/ hay mặt hàng thì từ khoá là kiểu tìm kiếm gần đúng. Ví dụ:
Tìm kiếm theo công ty: gõ từ khoá là "Coca"
thì cho phép lọc và copy tất cả các công ty có từ khoá này. Ví dụ: Cong ty Coca Cola 1; Company Coca Cola 2; Factory Coca Cola
Hay tìm kiếm theo tên hàng: ví dụ từ khoá là "chuot" thì cho phép lọc và copy tất cả mặt hàng: chuot logitech, chuot HP, chuot China...

Xin chân thành cảm ơn!

 

[ego.bizzin]

Mong có thể giải quyết bài toán của bạn.

1# Không dùng VBA

2# Lọc ngay trên sheet Dulieu

3# Đánh dấu "X" trên tiêu đề để tìm kiếm

4# Tại cột J, lọc giá trị TRUE

5# Gõ nội dung cần tìm vào ô có tên _searchTerm

6# (Trong excel 2007+) Ấn {CTRL+ALT+L} để cập nhật thay đổi

7# Các hàm sử dụng : ISNA, ISNUMBER, MATCH, SEARCH

Thân.

 

[nghiaphuc]

Còn đây là một cách dùng VBA để tham khảo:
1. Chuẩn hóa lại Validation tại ô B2 để đảm bảo trùng khớp với tiêu đề bảng dữ liệu nguồn.
2. Sử dụng code sau cho việc tìm kiếm:
[GPECODE=vb]Sub TimKiem()
Dim TuKhoa As String, Cot As String, VT As Long, Tmp, Tmp1, Arr()
Dim i As Long, j As Long, k As Long, DK As Boolean

TuKhoa = Sheets("Trichloc").[B1]
Cot = Sheets("Trichloc").[B2]
If Len(TuKhoa) * Len(Cot) = 0 Then
MsgBox "Chua nhap du thong tin.": Exit Sub
End If
Tmp = Sheets("Dulieu").[A2:G10000]
ReDim Arr(1 To UBound(Tmp), 1 To 7)
With WorksheetFunction
Tmp1 = .Transpose(Sheets("Dulieu").[A1:G1])
VT = .Match(Cot, Tmp1, 0)
End With
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If VT = 2 Or VT = 5 Then
DK = InStr(1, Tmp(i, VT), TuKhoa, vbTextCompare) > 0
Else
DK = (Tmp(i, VT) = TuKhoa)
End If
If DK Then
k = k + 1
For j = 1 To 7
Arr(k, j) = Tmp(i, j)
Next
End If
Next
Sheets("Trichloc").[A5:G10000].Clear
If k > 0 Then Sheets("Trichloc").[A5:G5].Resize(k).Value = Arr
End Sub[/GPECODE]
Bạn tham khảo trong file đính kèm nhé.

 

[alexanderhuti]

Mong có thể giải quyết bài toán của bạn.

1# Không dùng VBA

2# Lọc ngay trên sheet Dulieu

3# Đánh dấu "X" trên tiêu đề để tìm kiếm

4# Tại cột J, lọc giá trị TRUE

5# Gõ nội dung cần tìm vào ô có tên _searchTerm

6# (Trong excel 2007+) Ấn {CTRL+ALT+L} để cập nhật thay đổi

7# Các hàm sử dụng : ISNA, ISNUMBER, MATCH, SEARCH

Thân.

Cảm ơn sự giúp đỡ của bạn. Mình cũng có thể chọn lựa cách này. Nhưng mình vẫn muốn dùng VBA hơn vì sự thật bảng tính của mình rất lớn và dữ liệu phức tạp hơn nhiều (do lấy ví dụ nên có nhiều dữ liệu nhạy cảm công ty mình ko đưa lên được).
Dù sao củng cảm ơn bạn.

 

[alexanderhuti]

Còn đây là một cách dùng VBA để tham khảo:
1. Chuẩn hóa lại Validation tại ô B2 để đảm bảo trùng khớp với tiêu đề bảng dữ liệu nguồn.
2. Sử dụng code sau cho việc tìm kiếm:
[GPECODE=vb]Sub TimKiem()
Dim TuKhoa As String, Cot As String, VT As Long, Tmp, Tmp1, Arr()
Dim i As Long, j As Long, k As Long, DK As Boolean

TuKhoa = Sheets("Trichloc").[B1]
Cot = Sheets("Trichloc").[B2]
If Len(TuKhoa) * Len(Cot) = 0 Then
MsgBox "Chua nhap du thong tin.": Exit Sub
End If
Tmp = Sheets("Dulieu").[A2:G10000]
ReDim Arr(1 To UBound(Tmp), 1 To 7)
With WorksheetFunction
Tmp1 = .Transpose(Sheets("Dulieu").[A1:G1])
VT = .Match(Cot, Tmp1, 0)
End With
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If VT = 2 Or VT = 5 Then
DK = InStr(1, Tmp(i, VT), TuKhoa, vbTextCompare) > 0
Else
DK = (Tmp(i, VT) = TuKhoa)
End If
If DK Then
k = k + 1
For j = 1 To 7
Arr(k, j) = Tmp(i, j)
Next
End If
Next
Sheets("Trichloc").[A5:G10000].Clear
If k > 0 Then Sheets("Trichloc").[A5:G5].Resize(k).Value = Arr
End Sub[/GPECODE]
Bạn tham khảo trong file đính kèm nhé.

Em rất chân thành cảm ơn anh Phúc. Đây đúng là code mà em cần.
Anh có thể dành chút thời gian giải thích công việc của đoạn code được không ạ. (vì em cũng chỉ mới mày mò VBA thôi, mua quyển sách của thầy Phan Tự Hướng về nghiên cứu cũng biết chút chút cơ bản).
Vì dữ liệu trong công ty em làm hàng ngày có khoảng 4 file, mỗi file là 1 năm, bắt đầu từ 2010-2014, nên em muốn hiểu rõ về đoạn code để tìm cách phát triển lọc dữ liệu của những workbook khác nhau.

 

[Cá ngừ F1]

Bài toán này Dùng advance filter cũng được..record marco đi bạn

 

[alexanderhuti]

Bài toán này Dùng advance filter cũng được..record marco đi bạn

Hi bạn,
Khi mình dùng macro ghi lại sau đó thử đoạn code lại thì bị báo lỗi: select method or range class failed

Sheets("Dulieu").Rows("1:1").Select
Selection.AutoFilter
Range("B5").Select
ActiveSheet.Range("$A$1:$G$23").AutoFilter Field:=2, Criteria1:=Sheets("Trichloc").Range("B1"), _
Operator:=xlAnd
Range("A1:G23").Select
Range("B5").Activate
Selection.Copy
Sheets("Trichloc").Select
Range("A4").Select
ActiveSheet.Paste

 

[phucbugis]

Hi bạn,
Khi mình dùng macro ghi lại sau đó thử đoạn code lại thì bị báo lỗi: select method or range class failed
...

bạn có thể dùng Advanced Filter, nhưng nên cài nhiều điều kiện lọc cùng lúc để xử lý nhiều trường hợp ngoài ý muốn.
'----
bạn để ý các Header phải giống nhau (có thể đảo vị trí cột) thì mới lọc ra đúng kết quả.

Sub GPE_loc()
    If Range("B2") <> "" Then Range("B2") = "*" & Range("B2").Value & "*"
    If Range("E2") <> "" Then Range("E2") = "*" & Range("E2").Value & "*"
    
    Sheets("Dulieu").Range("A1:G65000").AdvancedFilter Action:=xlFilterCopy, _
                                                CriteriaRange:=Range("A1:G2"), _
                                                CopyToRange:=Range("A4:G4"), _
                                                Unique:=False


End Sub

'----
file đính kèm ----> #32

 

[alexanderhuti]

Hi bạn phucbugis,

Nếu mình có thêm một sheet nữa, ví dụ như là sheet "DuLieu2", là thông tin của khách hàng năm khác, định dạng giống như sheet "Dulieu" thì phải thêm vào đoạn code như thế nào để khi lọc thì lọc được ở cả 2 sheet và dán vào sheet "Trichloc" vậy bạn?

 

[phucbugis]

Hi bạn phucbugis,

Nếu mình có thêm một sheet nữa, ví dụ như là sheet "DuLieu2", là thông tin của khách hàng năm khác, định dạng giống như sheet "Dulieu" thì phải thêm vào đoạn code như thế nào để khi lọc thì lọc được ở cả 2 sheet và dán vào sheet "Trichloc" vậy bạn?

bạn tải lại file và xem nhé, mình mới bổ sung thêm điều kiện lọc + tạo thêm 1 ô H2 để chọn tên sheet (bạn thử đổi tên sheet Dulieu -> Dulieu2 và ngược lại, rồi đưa sheet Dulieu2 vào test tiếp xem)

Sub GPE_loc()
Dim KH As Range, tenhang As Range
Dim ws As Worksheet
'On Error GoTo Thoat 'xay ra loi~ neu Ten sheet ko tim` thay'
Set ws = ThisWorkbook.Worksheets(Range("H2").Value)
Set KH = Range("B2")
Set tenhang = Range("E2")

    If KH <> "" And Left(KH, 1) <> "*" Then KH = "*" & KH.Value & "*"
    If tenhang <> "" And Left(tenhang, 1) <> "*" Then tenhang = "*" & tenhang.Value & "*"
    
    ws.Range("A1:G65000").AdvancedFilter Action:=xlFilterCopy, _
                                                CriteriaRange:=Range("A1:G2"), _
                                                CopyToRange:=Range("A4:G4"), _
                                                Unique:=False
    
    Set ws = Nothing: Set KH = Nothing: Set tenhang = Nothing
'Thoat:
    'MsgBox (Err.Description)
End Sub

'----
file đính kèm ----> #32

 

[Ba Tê]

Hi bạn phucbugis,

Nếu mình có thêm một sheet nữa, ví dụ như là sheet "DuLieu2", là thông tin của khách hàng năm khác, định dạng giống như sheet "Dulieu" thì phải thêm vào đoạn code như thế nào để khi lọc thì lọc được ở cả 2 sheet và dán vào sheet "Trichloc" vậy bạn?

Sử dụng code của nghiaphuc đi, chỉnh lại 1 chút là cho bạn 100 sheet Dulieu luôn (Miễn tên sheet bắt đầu bằng chữ Dulieu)
Mượn Code và File của nghiaphuc nhé.
[GPECODE=vb]
Sub TimKiem() Dim TuKhoa As String, Cot As String, VT As Long, Tmp, Tmp1, Arr()
Dim i As Long, j As Long, k As Long, DK As Boolean, Ws As Worksheet
TuKhoa = Sheets("Trichloc").[B1]
Cot = Sheets("Trichloc").[B2]
If Len(TuKhoa) * Len(Cot) = 0 Then
MsgBox "Chua nhap du thong tin.": Exit Sub
End If
ReDim Arr(1 To 1000, 1 To 7)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name Like "Dulieu*" Then
Tmp = Ws.[A2:G10000]
With WorksheetFunction
Tmp1 = .Transpose(Ws.[A1:G1])
VT = .Match(Cot, Tmp1, 0)
End With
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If VT = 2 Or VT = 5 Then
DK = InStr(1, Tmp(i, VT), TuKhoa, vbTextCompare) > 0
Else
DK = (Tmp(i, VT) = TuKhoa)
End If
If DK Then
k = k + 1
For j = 1 To 7
Arr(k, j) = Tmp(i, j)
Next
End If
Next
End If
Next Ws
Sheets("Trichloc").[A5:G10000].Clear
If k > 0 Then Sheets("Trichloc").[A5:G5].Resize(k).Value = Arr
End Sub[/GPECODE]

 

[alexanderhuti]

Hi bạn phucbugis,

Đoạn code làm việc tốt khi mình thêm vào sheet "Dulieu2".
tuy nhiên, ý mình là mình có sheet "Dulieu" là thông tin năm 2012 chẳng hạn, và "Dulieu2" là thông tin năm 2013, "Dulieu3" là thông tin năm 2014,....
Ví dụ khách hàng có tên gần đúng là coca đều có dữ liệu tại cả 3 sheet trên, giờ mình muốn lọc coca này từ cả 3 sheet và dán vào sheet trichloc để mình có thể xem lại quá khứ những lần mua hàng của coca này.
Mong bạn giúp đỡ!

 

[nghiaphuc]

Hi bạn phucbugis,

Đoạn code làm việc tốt khi mình thêm vào sheet "Dulieu2".
tuy nhiên, ý mình là mình có sheet "Dulieu" là thông tin năm 2012 chẳng hạn, và "Dulieu2" là thông tin năm 2013, "Dulieu3" là thông tin năm 2014,....
Ví dụ khách hàng có tên gần đúng là coca đều có dữ liệu tại cả 3 sheet trên, giờ mình muốn lọc coca này từ cả 3 sheet và dán vào sheet trichloc để mình có thể xem lại quá khứ những lần mua hàng của coca này.
Mong bạn giúp đỡ!

Bạn xem lại bài ở trên của thầy Ba Tê đi, code đáp ứng được yêu cầu của bạn đấy.

 

[alexanderhuti]

Bạn xem lại bài ở trên của thầy Ba Tê đi, code đáp ứng được yêu cầu của bạn đấy.

Vâng, em cảm ơn thầy Ba Tê và cảm ơn anh Phúc.

Cho em hỏi thêm là nếu "dulieu" của em từ cột A đến cột Z... chẳng hạn, và cho phép tìm gần đúng chỉ ở các cột B, E, G, I thì sửa lại code như thế nào ạ!?

 

[phucbugis]

Hi bạn phucbugis,
Đoạn code làm việc tốt khi mình thêm vào sheet "Dulieu2".
tuy nhiên, ý mình là mình có sheet "Dulieu" là thông tin năm 2012 chẳng hạn, và "Dulieu2" là thông tin năm 2013, "Dulieu3" là thông tin năm 2014,....
Ví dụ khách hàng có tên gần đúng là coca đều có dữ liệu tại cả 3 sheet trên, giờ mình muốn lọc coca này từ cả 3 sheet và dán vào sheet trichloc để mình có thể xem lại quá khứ những lần mua hàng của coca này.
Mong bạn giúp đỡ!

ah,
thế thì rắc rối rồi, thông thường Advanced Filter chỉ lọc được từng sheet duy nhất , còn áp dụng cho nhiều sheet thì mình chưa thấy ai làm bao h cả

 

[nghiaphuc]

Vâng, em cảm ơn thầy Ba Tê và cảm ơn anh Phúc.

Cho em hỏi thêm là nếu "dulieu" của em từ cột A đến cột Z... chẳng hạn, và cho phép tìm gần đúng chỉ ở các cột B, E, G, I thì sửa lại code như thế nào ạ!?

Bạn xem lại code trong bài của thầy Ba Tê:
1. Những chỗ nào địa chỉ có dạng A...:G... thì bạn sửa thành A...:Z... (chẳng hạn A1:G1 thành A1:Z1)
2. Câu lệnh If: If VT = 2 Or VT = 5 Then
bạn sửa lại thành If InStr(1,".2.5.7.9.","." & VT & ".",vbTextCompare) > 0 Then

 

[nghiaphuc]

ah,
thế thì rắc rối rồi, thông thường Advanced Filter chỉ lọc được từng sheet duy nhất , còn áp dụng cho nhiều sheet thì mình chưa thấy ai làm bao h cả

Vậy thì ta copy tuốt tuồn tuột vào 1 sheet (chứa ở một vùng tạm nào đó) rồi dùng Advanced Filter một lần luôn. Sau đó thì xóa cái vùng tạm đó đi.

Bổ sung thêm một chút: Nếu không muốn xóa cái vùng tạm đó đi thì mình có thể copy tất cả từ các sheet vào vị trí chứa kết quả luôn, sau đó sử dụng Advanced Filter với Action là xlFilterInPlace

 

[Ba Tê]

ah,
thế thì rắc rối rồi, thông thường Advanced Filter chỉ lọc được từng sheet duy nhất , còn áp dụng cho nhiều sheet thì mình chưa thấy ai làm bao h cả

Thử SUB này xem sao, muốn bi nhiêu cột thì chỉ cần sửa 1 chỗ một thôi.
[GPECODE=vb]
Sub GPE_()
Dim DK1 As String, DK2 As String, C As Long, Ws As Worksheet
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String, Col As Long
With Sheets("Trichloc")
DK1 = UCase(.[B1])
DK2 = UCase(.[B2])
C = 24 '<-----------Muon bi nhieu cot thi sua so nay
For J = 1 To C
If UCase(.Cells(4, J)) = DK2 Then
Col = J
Exit For
End If
Next J
End With
ReDim dArr(1 To 10000, 1 To C)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name Like "Dulieu*" Then
sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, C).Value2
For I = 1 To UBound(sArr, 1)
Tem = UCase(sArr(I, Col))
If Tem Like "*" & DK1 & "*" Then
K = K + 1
For J = 1 To C
dArr(K, J) = sArr(I, J)
Next J
End If
Next I
End If
Next Ws
With Sheets("Trichloc")
.[A5:A10000].Resize(, C).ClearContents
If K > 0 Then .[A5].Resize(K, C) = dArr
End With
End Sub[/GPECODE]

 

[alexanderhuti]

Bạn xem lại code trong bài của thầy Ba Tê:
1. Những chỗ nào địa chỉ có dạng A...:G... thì bạn sửa thành A...:Z... (chẳng hạn A1:G1 thành A1:Z1)
2. Câu lệnh If: If VT = 2 Or VT = 5 Then
bạn sửa lại thành If InStr(1,".2.5.7.9.","." & VT & ".",vbTextCompare) > 0 Then

Cảm ơn a Phúc. Em đã test với file công việc của em, chạy rất tốt ạ.
Vậy anh xem giúp em trường hợp nếu có nhiều sheet Dulieu*, nhưng nằm ở các workbook khác nhau thì có lọc được không ạ. (Vì thật sự file từng năm của em dữ liệu tại mỗi sheet đã lên đến gần 50,000 dòng, mỗi file đã chứa khoảng 5 sheet, em không thể gom tất cả các sheet lại vào 1 workbook vì như vậy dung lượng file rất lớn, với lại khó theo dõi).

 

[alexanderhuti]

Với lại các anh có thể xem giúp em đoạn code này không ạ: Khi em lọc theo cột Y (là cột cuối cùng trong dulieu) thì báo lỗi ở phần chữ màu đỏ:

Sub TimKiem()
Dim TuKhoa As String, Cot As String, VT As Long, Tmp, Tmp1, Arr()
Dim i As Long, j As Long, k As Long, DK As Boolean, Ws As Worksheet
TuKhoa = Sheets("Trichloc").[B1]
Cot = Sheets("Trichloc").[B2]
If Len(TuKhoa) * Len(Cot) = 0 Then
MsgBox "Chua nhap du thong tin.": Exit Sub
End If
ReDim Arr(1 To 1000, 1 To 25)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name Like "Dulieu*" Then
Tmp = Ws.[A3:Y10000]
With WorksheetFunction
Tmp1 = .Transpose(Ws.[A1:Y1])
VT = .Match(Cot, Tmp1, 0)
End With
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If VT = 21 Or VT = 22 Then
DK = InStr(1, Tmp(i, VT), TuKhoa, vbTextCompare) > 0
Else
DK = (Tmp(i, VT) = TuKhoa)
End If
If DK Then
k = k + 1
For j = 1 To 25
Arr(k, j) = Tmp(i, j)
Next
End If
Next

 

[nghiaphuc]

Cảm ơn a Phúc. Em đã test với file công việc của em, chạy rất tốt ạ.
Vậy anh xem giúp em trường hợp nếu có nhiều sheet Dulieu*, nhưng nằm ở các workbook khác nhau thì có lọc được không ạ. (Vì thật sự file từng năm của em dữ liệu tại mỗi sheet đã lên đến gần 50,000 dòng, mỗi file đã chứa khoảng 5 sheet, em không thể gom tất cả các sheet lại vào 1 workbook vì như vậy dung lượng file rất lớn, với lại khó theo dõi).

Tất nhiên là được, tuy nhiên vấn đề bây giờ sẽ rắc rối hơn. Về ý tưởng thì thế này:
1. Mở lần lượt từng file được chọn.
2. Với file đang mở, duyệt qua các sheet có tên dạng Dulieu*, gán các bản ghi thỏa mãn điều kiện vào mảng Arr, sau đó đóng file vừa mở đi.
3. Sau khi thao tác với tất cả các file được chọn thì gán mảng Arr vào sheet chứa kết quả.
Bạn chịu khó tìm kiếm trên diễn đàn, vấn đề tổng hợp dữ liệu từ nhiều file được đề cập khá nhiều trên diễn đàn rồi.

Với lại các anh có thể xem giúp em đoạn code này không ạ: Khi em lọc theo cột Y (là cột cuối cùng trong dulieu) thì báo lỗi ở phần chữ màu đỏ:
...................................

Về mặt thuật toán thì tôi thấy không có vấn đề gì. Tôi nghi ngờ trường hợp này số bản ghi thỏa mãn điều kiện lớn hơn 1000 (là số phần tử tối đa của mảng Arr) nên phát sinh ra lỗi. Bạn mô tả cụ thể hơn về trường hợp này xem sao.

 

[alexanderhuti]

Cảm ơn anh. Em sẽ cố gắng thep ý tưởng trên để phát triển tiếp.

 

[alexanderhuti]

Tất nhiên là được, tuy nhiên vấn đề bây giờ sẽ rắc rối hơn. Về ý tưởng thì thế này:
1. Mở lần lượt từng file được chọn.
2. Với file đang mở, duyệt qua các sheet có tên dạng Dulieu*, gán các bản ghi thỏa mãn điều kiện vào mảng Arr, sau đó đóng file vừa mở đi.
3. Sau khi thao tác với tất cả các file được chọn thì gán mảng Arr vào sheet chứa kết quả.
Bạn chịu khó tìm kiếm trên diễn đàn, vấn đề tổng hợp dữ liệu từ nhiều file được đề cập khá nhiều trên diễn đàn rồi.

Về mặt thuật toán thì tôi thấy không có vấn đề gì. Tôi nghi ngờ trường hợp này số bản ghi thỏa mãn điều kiện lớn hơn 1000 (là số phần tử tối đa của mảng Arr) nên phát sinh ra lỗi. Bạn mô tả cụ thể hơn về trường hợp này xem sao.

Hi anh Phúc,
Anh xem lại file đính kèm giúp em. Em trình bày rõ hơn ạ:
- Workbook Tonghop sẽ có vài sheet "TOKHAI*" và 1 sheet trichloc, Mỗi sheet "TOKHAI*" có dữ liệu từ A2:AE50000 (khoảng gần 50,000 dòng)
- Cho phép tìm gần đúng ở các cột M, Q, X
- Em lại có 1 workbook khác (ví dụ như là Workbook "Tonghop2012"), vẫn chứa các sheets "TOKHAI*".
Anh xem giúp em lại đoạn code nhé!

 

[alexanderhuti]

em xin nhờ các tiền bối giúp em vấn đề này ạ.! Em cảm ơn!

 

[Ba Tê]

em xin nhờ các tiền bối giúp em vấn đề này ạ.! Em cảm ơn!

Chắc không ai dám xen vào ngoài các anh ... đâu.
Tôi đã tham gia từ bài #11, sau đó bạn luôn "Hi anh ..."
Bạn chờ anh ... đi.

 

[alexanderhuti]

Hix.. thầy ơi
Do công ty em đang có đợt kiểm toán nên em cần ứng dụng này để phục vụ trong công việc cuối tuần này ạ.
Thầy có thể giúp giùm em ạ. Em chân thành cảm ơn thầy!!

 

[nghiaphuc]

Chắc không ai dám xen vào ngoài các anh ... đâu.
Tôi đã tham gia từ bài #11, sau đó bạn luôn "Hi anh ..."
Bạn chờ anh ... đi.

Ayza, bác lại cả nghĩ rồi, giúp được thì làm ơn giúp người ta đi mà... Ẹc ẹc....

 

[Ba Tê]

Ayza, bác lại cả nghĩ rồi, giúp được thì làm ơn giúp người ta đi mà... Ẹc ẹc....

Híc! Oan "Thị Mầu"
ego.bizzin bài #2
Cá ngừ F1 Bài #6
phucbugis Bài #8 , #10, #13
Ba Tê #11 #18
Đâu có bài nào được đá động đến đâu. Giúp sao nữa đây?
Éc,Éc...

 

[alexanderhuti]

Híc! Oan "Thị Mầu"
ego.bizzin bài #2
Cá ngừ F1 Bài #6
phucbugis Bài #8 , #10, #13
Ba Tê #11 #18
Đâu có bài nào được đá động đến đâu. Giúp sao nữa đây?
Éc,Éc...

Hix... Thầy có thể xem giúp em đoạn code này với ạ. Do em mở rộng đến cột AE nên em đã thay đổi ở những dòng màu đỏ. Nhưng khi đưa dữ liệu vào lọc vẫn không được ạ.

Sub TimKiem()
Dim TuKhoa As String, Cot As String, VT As Long, Tmp, Tmp1, Arr()
Dim i As Long, j As Long, k As Long, DK As Boolean, Ws As Worksheet
TuKhoa = Sheets("Trichloc").[B1]
Cot = Sheets("Trichloc").[B2]
If Len(TuKhoa) * Len(Cot) = 0 Then
MsgBox "Chua nhap du thong tin.": Exit Sub
End If
ReDim Arr(1 To 1000, 1 To 31)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name Like "TOKHAI*" Then
Tmp = Ws.[A2:AE10000]
With WorksheetFunction
Tmp1 = .Transpose(Ws.[A2:AE2])
VT = .Match(Cot, Tmp1, 0)
End With
For i = 1 To UBound(Tmp)
If IsEmpty(Tmp(i, 1)) Then Exit For
If VT = 13 Or VT = 17 Then (chỗ này cho phép tìm gần đúng ở cột M, Q, X, em không biết sửa thế nào)
DK = InStr(1, Tmp(i, VT), TuKhoa, vbTextCompare) > 0
Else
DK = (Tmp(i, VT) = TuKhoa)
End If
If DK Then
k = k + 1
For j = 1 To 31
Arr(k, j) = Tmp(i, j)
Next
End If
Next
End If
Next Ws
Sheets("Trichloc").[A5:AE65000].Clear
If k > 0 Then Sheets("Trichloc").[A5:AE5].Resize(k).Value = Arr
End Sub

Em cảm ơn!

 

[phucbugis]

Hix... Thầy có thể xem giúp em đoạn code này với ạ. Do em mở rộng đến cột AE nên em đã thay đổi ở những dòng màu đỏ. Nhưng khi đưa dữ liệu vào lọc vẫn không được ạ.
...

chào bạn,

- theo như #21, #23 thì bây giờ bạn đã nhập số liệu các file vào một rồi sao?

---> nếu vậy thì mình có thể giúp bạn dùng Advanced Filter lọc qua được nhiều sheet (nhờ bác nghiaphuc đã gợi ý cách làm và đã thử nghiệm xong!) Có điều bạn hãy gửi lại 1 file có thêm 1 ít số liệu để dễ hình dung vì còn phải cài điều kiện nữa.

 

[alexanderhuti]

chào bạn,

- theo như #21, #23 thì bây giờ bạn đã nhập số liệu các file vào một rồi sao?

---> nếu vậy thì mình có thể giúp bạn dùng Advanced Filter lọc qua được nhiều sheet (nhờ bác nghiaphuc đã gợi ý cách làm và đã thử nghiệm xong!) Có điều bạn hãy gửi lại 1 file có thêm 1 ít số liệu để dễ hình dung vì còn phải cài điều kiện nữa.

Hi bác,

Mình gửi lại file nhờ bác xem:

File sẽ có 7 sheet dữ liệu, mỗi sheet dữ liệu dao động từ 15,000 - ~50,000 dòng, (nhưng thực tế công việc có thể lên đến khoảng gần 20 sheets như vậy)
Các cột cho phép tìm kiếm gần đúng gồm: E, U, V, X, Y (đã tô màu vàng). [^^ mà nếu được thì tốt nhất là cho phép tìm kiếm gần đúng hết; chỉ có 3 cột P, R, S dữ liệu luôn là number nên bắt buộc tìm kiếm đúng hoàn toàn. Vd: 112 kg thì phải tìm đúng 112, chứ gõ 1 vào mà vẫn hiện ra 112 thì lọc ra nhiều quá).

Xim cảm ơn!

 

[phucbugis]

Hi bác,
Mình gửi lại file nhờ bác xem:

File sẽ có 7 sheet dữ liệu, mỗi sheet dữ liệu dao động từ 15,000 - ~50,000 dòng, (nhưng thực tế công việc có thể lên đến khoảng gần 20 sheets như vậy)
Các cột cho phép tìm kiếm gần đúng gồm: E, U, V, X, Y (đã tô màu vàng). [^^ mà nếu được thì tốt nhất là cho phép tìm kiếm gần đúng hết; chỉ có 3 cột P, R, S dữ liệu luôn là number nên bắt buộc tìm kiếm đúng hoàn toàn. Vd: 112 kg thì phải tìm đúng 112, chứ gõ 1 vào mà vẫn hiện ra 112 thì lọc ra nhiều quá).

Xim cảm ơn!

bạn tải file đính kèm về kiểm tra xem có đúng ko nhé !
[GPECODE=vb]
Sub GPE_AdvFilter()
Dim Ws As Worksheet
Dim Ws1 As Worksheet
Dim dkloc As Range
Dim vung1 As Range
Dim vung2 As Range


Application.ScreenUpdating = False


Set Ws1 = Sheets("Trichloc")
Set dkloc = Ws1.Range("C1:C2")

If Application.WorksheetFunction.CountIf([A1:A3], [C1]) = 0 And Left([C2], 1) <> "*" Then
[C2] = "*" & [C2].Value & "*"
End If

Ws1.Range("A5:Z65000").ClearContents

For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> Ws1.Name Then
With Ws
Set vung1 = .Range(.Range("A65000").End(xlUp), .Range("Y1"))
vung1.AdvancedFilter Action:=xlFilterInPlace, _
CriteriaRange:=dkloc, _
Unique:=False
'dieu kien <> 1 <=> tim` thay' so' lieu loc. (row1=Header)
If .Range("A" & Rows.Count).End(xlUp).Row <> 1 Then
Set vung2 = .Range(.[A65000].End(xlUp), .[Y2])
'copy vung` da~ loc. (neu cac sheet kia co' chua' cong thuc' -> co' the bi. anh? huong)
vung2.Copy Destination:=Ws1.Range("B" & Rows.Count).End(xlUp).Offset(1)
Ws1.Range("A" & Rows.Count).End(xlUp).Offset(1).Resize(vung2.Rows.Count) = Ws.Name
End If


Ws.ShowAllData 'dat ngoai` If + viet day` du?
End With
End If
Next Ws

Set Ws1 = Nothing: Set dkloc = Nothing: Set vung1 = Nothing: Set vung2 = Nothing


Application.ScreenUpdating = True
End Sub
[/GPECODE]

link: https://www.mediafire.com/?g1scuh0typ00bhw

 

[Ba Tê]

Hix... Thầy có thể xem giúp em đoạn code này với ạ. Do em mở rộng đến cột AE nên em đã thay đổi ở những dòng màu đỏ. Nhưng khi đưa dữ liệu vào lọc vẫn không được ạ.

...............................

Em cảm ơn!

Nếu tôi làm thì làm như vầy:
Cột nào muốn tìm chính xác thì tô màu vào dòng 5 của cột đó, Tôi tô P5,R5 và S5, bạn có thể chọn thêm.
Cột nào không tô màu thì tìm gần giống.
Lấy tất cả các sheet có tên khác với "Trichloc" ghi vào sheet "Trichloc".
Dữ liệu khoảng 20 sheet, mỗi sheet khoảng 50.000 dòng hổng biết chạy có nỗi không.

 

[alexanderhuti]

Nếu tôi làm thì làm như vầy:
Cột nào muốn tìm chính xác thì tô màu vào dòng 5 của cột đó, Tôi tô P5,R5 và S5, bạn có thể chọn thêm.
Cột nào không tô màu thì tìm gần giống.
Lấy tất cả các sheet có tên khác với "Trichloc" ghi vào sheet "Trichloc".
Dữ liệu khoảng 20 sheet, mỗi sheet khoảng 50.000 dòng hổng biết chạy có nỗi không.

Em cảm ơn thầy rất nhiều.

Thầy xem giúp em đoạn báo lỗi màu đỏ này có phải là do "mảng dữ liệu quá lớn" hay không ạ? Thầy giúp giùm em cách khắc phục với. Em cảm ơn!

........................
........................
Next Ws
.[A6:A60000].Resize(, C).ClearContents
If K Then .[A6].Resize(K, C) = dArr
End With
Application.ScreenUpdating = True
End Sub

 

[phamsuabe]

Nếu tôi làm thì làm như vầy:
Cột nào muốn tìm chính xác thì tô màu vào dòng 5 của cột đó, Tôi tô P5,R5 và S5, bạn có thể chọn thêm.
Cột nào không tô màu thì tìm gần giống.
Lấy tất cả các sheet có tên khác với "Trichloc" ghi vào sheet "Trichloc".
Dữ liệu khoảng 20 sheet, mỗi sheet khoảng 50.000 dòng hổng biết chạy có nỗi không.

Em thì chỉ cần lấy dữ liệu ở 1 sheet (khoảng 500000 dòng) nhưng chỉ cần lấy vài cột nhất định chứ không phải lấy tất cả các cột như trên. Vì dụ chỉ lấy cột 2, 4, 7 chẳng hạn thì em phải sửa như thế nào ạ. Em cảm ơn!

 

[Excel365]

Thử SUB này xem sao, muốn bi nhiêu cột thì chỉ cần sửa 1 chỗ một thôi.
[GPECODE=vb]
Sub GPE_()
Dim DK1 As String, DK2 As String, C As Long, Ws As Worksheet
Dim sArr(), dArr(), I As Long, J As Long, K As Long, Tem As String, Col As Long
With Sheets("Trichloc")
DK1 = UCase(.[B1])
DK2 = UCase(.[B2])
C = 24 '<-----------Muon bi nhieu cot thi sua so nay
For J = 1 To C
If UCase(.Cells(4, J)) = DK2 Then
Col = J
Exit For
End If
Next J
End With
ReDim dArr(1 To 10000, 1 To C)
For Each Ws In ThisWorkbook.Worksheets
If Ws.Name Like "Dulieu*" Then
sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, C).Value2
For I = 1 To UBound(sArr, 1)
Tem = UCase(sArr(I, Col))
If Tem Like "*" & DK1 & "*" Then
K = K + 1
For J = 1 To C
dArr(K, J) = sArr(I, J)
Next J
End If
Next I
End If
Next Ws
With Sheets("Trichloc")
.[A5:A10000].Resize(, C).ClearContents
If K > 0 Then .[A5].Resize(K, C) = dArr
End With
End Sub[/GPECODE]

Chào các anh chị,
Sẵn tiện đây mượn file của tác giả cho em hỏi, bây giờ em muốn thống kê trong 1 khoản thời gian nào đó ở tất cả các sheet (Bắt đầu từ ngày - đến ngày ). Nhờ các anh chị giúp em Trân trọng cảm ơn

 

[SA_DQ]

Option Explicit
Sub GPE()
 Dim DK1$, DK2$, Tem$
 Dim Cot&, I&, J&, K&, Col&, fDat As Date, lDat As Date
 Dim sArr(), dArr(), Ws As Worksheet
 
 With Sheets("Trichloc")
    DK1 = UCase$(.[c1].Value):                  fDat = [f1].Value
    DK2 = UCase$(.[c2].Value):                  lDat = [f2].Value
    Cot = [b4].CurrentRegion.Columns.Count + 2
    .[A5:A10000].Resize(, Cot).ClearContents
    For J = 1 To Cot
        If UCase$(.Cells(4, J).Value) = DK2 Then
            Col = J:                            Exit For
        End If
    Next J
 End With
 ReDim dArr(1 To 10 ^ 4, 1 To Cot)
 For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "Dulieu*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, Cot).Value2
        For I = 1 To UBound(sArr, 1)
            Tem = UCase$(sArr(I, Col))
            If Tem Like "*" & DK1 & "*" And (sArr(I, 8) >= fDat And sArr(I, 8) <= lDat) Then    '*'
                K = K + 1
                For J = 1 To Cot
                    dArr(K, J) = sArr(I, J)
                Next J
            End If
        Next I
    End If
 Next Ws
 If K > 0 Then Sheets("Trichloc").[A5].Resize(K, Cot) = dArr
End Sub

 

[nghiapv084]

Giúp đỡ em Code trích lọc dữ liệu

Option Explicit
Sub GPE()
 Dim DK1$, DK2$, Tem$
 Dim Cot&, I&, J&, K&, Col&, fDat As Date, lDat As Date
 Dim sArr(), dArr(), Ws As Worksheet
 
 With Sheets("Trichloc")
    DK1 = UCase$(.[c1].Value):                  fDat = [f1].Value
    DK2 = UCase$(.[c2].Value):                  lDat = [f2].Value
    Cot = [b4].CurrentRegion.Columns.Count + 2
    .[A5:A10000].Resize(, Cot).ClearContents
    For J = 1 To Cot
        If UCase$(.Cells(4, J).Value) = DK2 Then
            Col = J:                            Exit For
        End If
    Next J
 End With
 ReDim dArr(1 To 10 ^ 4, 1 To Cot)
 For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name Like "Dulieu*" Then
        sArr = Ws.Range(Ws.[A2], Ws.[A65536].End(xlUp)).Resize(, Cot).Value2
        For I = 1 To UBound(sArr, 1)
            Tem = UCase$(sArr(I, Col))
            If Tem Like "*" & DK1 & "*" And (sArr(I, 8) >= fDat And sArr(I, 8) <= lDat) Then    '*'
                K = K + 1
                For J = 1 To Cot
                    dArr(K, J) = sArr(I, J)
                Next J
            End If
        Next I
    End If
 Next Ws
 If K > 0 Then Sheets("Trichloc").[A5].Resize(K, Cot) = dArr
End Sub

------------

Xin các thầy giúp em đoạn code để trích lọc dữ liệu , các cột tô màu vàng trong bảng tìm kiếm là vị trí cần load các dữ liệu bên data . cột biên bản là nơi nhập dữ liệu tìm kiếm . em xin cảm ơn .

 

[thanhpd3]

Minh đang gặp vấn đề lọc dữ liệu.

Số là mình có 1 sheet data, mình cần lấy dữ liệu từ sheet data chuyển sang sheet báo cáo theo điều kiện 1 và điều kiện 2 & từ ngày đến ngày...

Mình không biết xử lý code VBA như thế nào, mong anh chị em GPE hướng dẫn giúp.

Mình xin gửi file đính kèm ạ

 

[thanhpd3]

Bạn biết xài Advanced Filter không? Nếu biết thì thử làm bằng tay & Quay Macro lại quá trình làm bằng tay là ra code VBA thôi...

Hi bạn, Do tính chất công việc thường lập đi lập lại, và dữ liệu rất nhiều. Nên mình cần một code VBA tối ưu nhất.

Mình đã thử các cách mình biết, trong đó có việc ghi lại macro tự động, nhưng vẫn ko hiệu quả bạn à. Mong bạn chỉ giúp mình

 

[AutoReply]

Public Sub GPE()
Dim sArr, dArr, I As Long, J As Long, K As Long
sArr = Sheet1.Range("A1").CurrentRegion.Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
For I = 3 To UBound(sArr)
    If sArr(I, 1) >= [E1].Value And sArr(I, 1) <= [E2].Value Then
        If sArr(I, 10) = [I2].Value Then
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next
        End If
    End If
Next

    If K Then
        [A6].CurrentRegion.Offset(1).ClearContents
        [A7].Resize(K, UBound(sArr, 2)).Value = dArr
    End If
End Sub

ủa anh hpkhuong ơi , anh ghi Macro làm sao mà ra được đoạn code này vậy ? chỉ em với. Chứ em thâu Macro thao tác Filter nó toàn ra cái code gì khác xa với code của anh không à. hic.

 

[thanhpd3]

Public Sub GPE()
Dim sArr, dArr, I As Long, J As Long, K As Long
sArr = Sheet1.Range("A1").CurrentRegion.Value
ReDim dArr(1 To UBound(sArr), 1 To UBound(sArr, 2))
For I = 3 To UBound(sArr)
    If sArr(I, 1) >= [E1].Value And sArr(I, 1) <= [E2].Value Then
        If sArr(I, 10) = [I2].Value Then
            K = K + 1
            For J = 1 To UBound(sArr, 2)
                dArr(K, J) = sArr(I, J)
            Next
        End If
    End If
Next

    If K Then
        [A6].CurrentRegion.Offset(1).ClearContents
        [A7].Resize(K, UBound(sArr, 2)).Value = dArr
    End If
End Sub

Hi hp Khuong

Trước hết cám ơn bạn đã nhiệt tình giúp đở mình nha. Mất nay mình ko vào diễn đàn nên trả lời hơi chậm, thông cảm giúp mình nhé

Ak, Code bạn gửi, mình ko thấy ĐK nào lọc từ ngày đến ngày cả. ???. Bạn trả lời giúp mình với

 

[Higabana]

em cũng có yêu cầu gần giống về vấn đề này mong mọi người giúp đỡ (em mới tìm hiểu về VBA đc 3 ngày).
- chỗ e có khoảng 14 Đại lý, mỗi đại lý sẽ có 1 mã đại lý từ 001 - 014
- BC of từng đại lý khá dày về nhiều thông số.em cần làm báo cáo tổng thống kê về tổng số KH của từng ĐL, có bnhiu KH mua Lẻ, bnhiu KH mua Sỉ ở từng ĐL đó.
- Kh ở từng đại lý sẽ có 1 mã KH tăng dần trong từng ĐL, ko bị trùng lắp do có mã ĐL trong mã KH (vd: KH ở ĐL 1 mang mã 001000435643, KH ở ĐL 5 mang mã 005000435643)
- Cột Loại KH sẽ cho biết KH nào mua lẻ KH nào mua Sỉ, 1 KH có thể phát sinh nhiều lần mua ở cùng 1 ĐL (cố định KH mua lẻ thì ko fai KH mua Sỉ), phát sinh nhiều lần mua, nhiều Hóa đơn khác nhau nhưng vẫn chỉ 1 mã KH.

mổi ĐL sẽ gửi BC hàng tháng về, e gom lại 14 cái BC vào 1 file Excel mỗi BC nằm ở 1 Sheet để làm. e mong mọi người giúp e code VBA cho vấn đề này!

Dữ liệu đã được mã hóa trên hệ thống nội bộ nên ko thể trích xuất ra và gửi cho mọi người xem!

 

[Văn Mai Hương]

Nếu tôi làm thì làm như vầy:
Cột nào muốn tìm chính xác thì tô màu vào dòng 5 của cột đó, Tôi tô P5,R5 và S5, bạn có thể chọn thêm.
Cột nào không tô màu thì tìm gần giống.
Lấy tất cả các sheet có tên khác với "Trichloc" ghi vào sheet "Trichloc".
Dữ liệu khoảng 20 sheet, mỗi sheet khoảng 50.000 dòng hổng biết chạy có nỗi không.

Cảm ơn Thầy Ba Tê, em thử dùng code thấy chạy tốt. Duy chỉ có trở ngại là khi em copy dữ liệu khác vào cái bảng mà Thầy đã tạo sẵn ( giữ nguyên các tiêu đề cột, chỉ thay đổi các bản ghi) thì code đều ko chạy, ko lọc ra được gì.
Muội xin nhờ Thầy Ba Tê cũng như các huynh trong GPE giải đáp giùm muội.
Muội xin cảm ơn !
P/s. Muội xin phép nói thêm là trường hợp như vậy muội gặp rất nhiều với các code khác. Khi muội lấy về chạy thử với dữ liệu cũ có sẵn thì rất tốt, nhưng cứ khi muội copy dữ liệu ở ngoài vào là code ko chạy nữa. Muội thực sự lạ quá, mong các Thầy, các Sư huynh chỉ giáo cho.

 

[CarotNho]

Cảm ơn Thầy Ba Tê, em thử dùng code thấy chạy tốt. Duy chỉ có trở ngại là khi em copy dữ liệu khác vào cái bảng mà Thầy đã tạo sẵn ( giữ nguyên các tiêu đề cột, chỉ thay đổi các bản ghi) thì code đều ko chạy, ko lọc ra được gì.
Muội xin nhờ Thầy Ba Tê cũng như các huynh trong GPE giải đáp giùm muội.
Muội xin cảm ơn !
P/s. Muội xin phép nói thêm là trường hợp như vậy muội gặp rất nhiều với các code khác. Khi muội lấy về chạy thử với dữ liệu cũ có sẵn thì rất tốt, nhưng cứ khi muội copy dữ liệu ở ngoài vào là code ko chạy nữa. Muội thực sự lạ quá, mong các Thầy, các Sư huynh chỉ giáo cho.

Tỉ tỉ đăng bài mới đi. Code viết cho file cụ thể, nếu cùng cấu trúc và kiểu dữ liệu của file đó mới áp dụng được.

 

[Văn Mai Hương]

Nếu tôi làm thì làm như vầy:
Cột nào muốn tìm chính xác thì tô màu vào dòng 5 của cột đó, Tôi tô P5,R5 và S5, bạn có thể chọn thêm.
Cột nào không tô màu thì tìm gần giống.
Lấy tất cả các sheet có tên khác với "Trichloc" ghi vào sheet "Trichloc".
Dữ liệu khoảng 20 sheet, mỗi sheet khoảng 50.000 dòng hổng biết chạy có nỗi không.

Muội đã chạy thử với khoảng 30 sheet, mỗi sheet cũng gần 30k dòng mà thấy vẫn ổn ạ. Hay là do muội đợi nó quen rồi hông bít nữa Muội xin cảm ơn !

 

[NguyenNgocThuHien]

Hi bạn, Do tính chất công việc thường lập đi lập lại, và dữ liệu rất nhiều. Nên mình cần một code VBA tối ưu nhất.

Mình đã thử các cách mình biết, trong đó có việc ghi lại macro tự động, nhưng vẫn ko hiệu quả bạn à. Mong bạn chỉ giúp mình

Bạn có thể sửa dụng code này, tùy biến thoải mái.
Có gì không hiểu thì xem video sau:

 

[huongmuine]

Xin nhờ các anh chị chỉ giúp:
Em xin mượn tạm file của Thầy Ba Tê để thực hiện. Em dời dòng điều kiện từ cột 1 sang cột 2 của sheet Trichloc thì điều kiện trích lọc đúng ( khi tô màu ô ở dòng 5 ) đã không còn tác dụng ( nó chỉ trích lọc các nội dung gần đúng ).
Nhờ các anh chị chỉ giúp phải chỉnh dòng lệnh chỗ nào để code có tác dụng như mong muốn ( khi tô màu ở ô nào thì sẽ trích lọc nội dung đúng theo yêu cầu đó ).