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

alexanderhuti · 27/4/14

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!

nghiaphuc · 28/4/14

alexanderhuti đã viết:
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.

alexanderhuti đã viết:
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 · 28/4/14

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

alexanderhuti · 28/4/14

nghiaphuc đã viết:
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 · 30/4/14

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

Ba Tê · 30/4/14

alexanderhuti đã viế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 · 30/4/14

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 · 30/4/14

Ba Tê đã viết:
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ê · 30/4/14

nghiaphuc đã viế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 · 1/5/14

Ba Tê đã viết:
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 · 1/5/14

alexanderhuti đã viế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 ạ.
...

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 · 1/5/14

phucbugis đã viết:
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 · 1/5/14

alexanderhuti đã viết:
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ê · 3/5/14

alexanderhuti đã viế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 · 6/5/14

Ba Tê đã viết:
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 · 7/5/15

Ba Tê đã viết:
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 · 19/5/15

Ba Tê đã viết:
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 · 20/5/15

PHP:

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 · 9/8/16

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

HYen17 đã viết:

PHP:

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 · 19/6/17

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 · 19/6/17

hpkhuong đã viết:
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

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

Người dùng đang xem chủ đề này

Thành viên chính thức

File đính kèm

Thành viên gạo cội

Thành viên chính thức

Thành viên chính thức

File đính kèm

Thành viên chính thức

Cạo Rồi Khỏi Gội

Thành viên chính thức

Thành viên gạo cội

Cạo Rồi Khỏi Gội

Thành viên chính thức

File đính kèm

Thành viên tích cực

Thành viên chính thức

File đính kèm

Thành viên tích cực

Cạo Rồi Khỏi Gội

File đính kèm

Thành viên chính thức

Thành viên mới

Thành viên tích cực

File đính kèm

/(hông là gì!

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

File đính kèm

Thành viên mới

Đếm ngược thời gian