Lọc dữ liệu có chứa ở các sheet (1 người xem)

[phungtrangtt]

Mọi người ơi,

Em có một file dữ liệu bao gồm nhiều sheet. Em muốn:
1. Nhập 01 mã tại ô tổng hợp (một số sheet có chữa mã này)
2. Sau khi nhập mã này thì tự động sẽ show kết quả như sheet "noi dung can the hien"


Nhờ các anh/chị/em vui lòng tìm hiểu và hướng dẫn giúp mình nha!

 

[seikoqn]

Mọi người ơi,

Em có một file dữ liệu bao gồm nhiều sheet. Em muốn:
1. Nhập 01 mã tại ô tổng hợp (một số sheet có chữa mã này)
2. Sau khi nhập mã này thì tự động sẽ show kết quả như sheet "noi dung can the hien"


Nhờ các anh/chị/em vui lòng tìm hiểu và hướng dẫn giúp mình nha!

Nếu dùng vba thì giải quyết theo hướng này:
+ Dùng vòng lặp duyệt qua tất cả các sheet.
+ Thấy mã nào thỏa mãn điều kiện thì gán vào mảng.

 

[doveandrose]

Nếu dùng vba thì giải quyết theo hướng này:
+ Dùng vòng lặp duyệt qua tất cả các sheet.
+ Thấy mã nào thỏa mãn điều kiện thì gán vào mảng.

người ta up file đuôi .xlsx thì 99% là không viết được VBA . bạn muốn giúp thì làm đến nơi luôn cho người ta đi

 

[doveandrose]

Mới học được code này. nên thực hành luôn..........Bạn mở file. Chọn giá trị tại A1 thì code sẽ chạy, sheet KQ (tôi đổi tên sheet, chứ file của bạn để tên sheet bằng Tiếng Việt loằng ngoằn quá.)

bạn ơi làm sao tạo ra được vùng M2:M10 vậy ?

 

[seikoqn]

người ta up file đuôi .xlsx thì 99% là không viết được VBA . bạn muốn giúp thì làm đến nơi luôn cho người ta đi

Bạn xem File nhé!
Chỉ cần nhập mã cần dò vào ô A1 của sheet "Noi Dung" là OK.

 

[doveandrose]

Bạn xem File nhé!
Chỉ cần nhập mã cần dò vào ô A1 của sheet "Noi Dung" là OK.

tôi đã xem .
khi viết mã CN1615050000005 vào ô A1 => OK ồ yea
sau đó viết mã CN1615050000002 vào ô A1 => rất tiếc , chúc bạn may mắn lần sau

 

[Ba Tê]

Mới học được code này. nên thực hành luôn..........Bạn mở file. Chọn giá trị tại A1 thì code sẽ chạy, sheet KQ (tôi đổi tên sheet, chứ file của bạn để tên sheet bằng Tiếng Việt loằng ngoằn quá.)

kq(i, 1) = DL(r, 2): kq(i, 2) = DL(r, 5): kq(i, 3) = DL(r, 6): kq(i, 4) = DL(r, 11):
kq(i, 5) = DL(r, 12): kq(i, 6) = DL(r, 16): kq(i, 7) = DL(r, 17): kq(i, 8) = DL(r, 8)

Thử cho mấy cột lấy dữ liệu vào 1 mảng cho dễ nhìn.

Public Sub KQua()
Dim DL, Ws As Worksheet, kq(1 To 1000000, 1 To 9)
Dim r As Long, i As Long, k As String, Arr, J As Long
k = Sheets("KQ").Range("A1").Value
Arr = Array(2, 5, 6, 11, 12, 16, 17, 8) '<-------------'
For Each Ws In Worksheets
    If Ws.Name <> "KQ" Then
        DL = Ws.UsedRange
        For r = 2 To UBound(DL)
            If DL(r, 13) = k Then
                i = i + 1
                For J = 0 To UBound(Arr)
                    kq(i, J + 1) = DL(r, Arr(J)) '<---------------'
                Next J
                kq(i, 9) = Ws.Name
            End If
        Next r
    End If
Next Ws
Sheets("KQ").Range("A8", Sheets("KQ").Range("I1000000").End(xlDown)).ClearContents
Sheets("KQ").Range("A8").Resize(i, 9) = kq
End Sub

 

[seikoqn]

tôi đã xem .
khi viết mã CN1615050000005 vào ô A1 => OK ồ yea
sau đó viết mã CN1615050000002 vào ô A1 => rất tiếc , chúc bạn may mắn lần sau

Ý bạn là dữ liệu cũ chưa bị xóa đi chứ gì? Nếu thế thêm dòng lệnh:
Sheets("Noi Dung").Range("A8").Resize(10000, 8).ClearContents
nữa là được thôi mà!

Option Explicit


Public Sub LOC()
Application.ScreenUpdating = False
Dim i As Long, Lr As Long, d As Long, VT As Long
Dim DL(), KQ(), DK As String
Dim Ws As Worksheet
ReDim KQ(1 To 10001, 1 To 8)


DK = Sheets("Noi Dung").Range("A1")


For Each Ws In Worksheets
Lr = Ws.Range("A" & Rows.Count).End(xlUp).Row
DL = Ws.Range("A2:Q" & Lr)
If Ws.Name <> "Noi Dung" Then
    For i = 1 To UBound(DL, 1)
        If DL(i, 13) = DK Then
        d = d + 1
        KQ(d, 1) = DL(i, 2)
        KQ(d, 2) = DL(i, 5)
        KQ(d, 3) = DL(i, 6)
        KQ(d, 4) = DL(i, 11)
        KQ(d, 5) = DL(i, 12)
        KQ(d, 6) = DL(i, 16)
        KQ(d, 7) = DL(i, 17)
        KQ(d, 8) = DL(i, 8)
        End If
    Next i
End If
Next


If d > 0 Then
[B][COLOR=#ff0000]    Sheets("Noi Dung").Range("A8").Resize(10000, 8).ClearContents[/COLOR][/B]
    Sheets("Noi Dung").Range("A8").Resize(d, 8) = KQ
End If
Application.ScreenUpdating = True
End Sub

 

[seikoqn]

người ta up file đuôi .xlsx thì 99% là không viết được VBA .

Bạn có vẻ am hiểu quá nhỉ! Vụ này nghe lần đâu!

 

[doveandrose]

Bạn có vẻ am hiểu quá nhỉ! Vụ này nghe lần đâu!

bạn đưa code cho người khác xài , đẹp xấu chưa cần biết , tối thiểu nhất là phải chạy đúng cái đã . phải không ?
nếu xong vấn đề của chủ topic thì mới đến tiết mục hỏi xoáy đáp xoay :
bài này có cách nào chỉ dùng 1 vòng lặp không ta ?

 

[chuot0106]

bài này có cách nào chỉ dùng 1 vòng lặp không ta ?

Thử cách củ chuối này xem sao?

 

[Ba Tê]

bạn đưa code cho người khác xài , đẹp xấu chưa cần biết , tối thiểu nhất là phải chạy đúng cái đã . phải không ?
nếu xong vấn đề của chủ topic thì mới đến tiết mục hỏi xoáy đáp xoay :
bài này có cách nào chỉ dùng 1 vòng lặp không ta ?

1 vòng lặp đây, xem file đính kèm.

Public Sub GPE_1For()
Application.ScreenUpdating = False
Dim Ws As Worksheet, Rng As Range, Rws As Long, TieuDe As Range, DK As Range
With Sheets("TongHop")
    .Range("A8:H10000").Clear
    Set DK = .Range("A1:A2"): Set TieuDe = .Range("A7:H7")
    For Each Ws In Worksheets
        If Ws.Name <> "TongHop" Then
            Rws = .Range("A65536").End(xlUp).Row + 1
            TieuDe.Copy .Range("A" & Rws)
            Set Rng = Ws.UsedRange
                Rng.AdvancedFilter Action:=xlFilterCopy, _
                CriteriaRange:=DK, CopyToRange:=.Range("A" & Rws).Resize(, 8)
            .Range("A" & Rws).Resize(, 8).Delete Shift:=xlUp
        End If
    Next Ws
    Set Rng = Nothing: Set TieuDe = Nothing: Set DK = Nothing
End With
End Sub

 

[doveandrose]

cám ơn các bạn (anh) . các bạn nhiệt tình quá . hihi
@Chuot0106 : chức năng copyto của advanced filter tự dò tên cột trong vùng copyto , nó thấy tên cột nào "dính chấu" thì nó copy khỏi cần copy từng cột .
nghe truyền thuyết kể lại rằng dùng chức năng filter cho tốc độ nhanh hơn dùng vòng lặp .
nhưng trường hợp này cách dùng filter bị "kẹt" cái lệnh

.Range("A" & Rws).Resize(, 8).Delete Shift:=xlUp

đâm ra cuối cùng lại làm cho quá trình bị lâu hơn cách dùng vòng lặp

 

[chuot0106]

cám ơn các bạn (anh) . các bạn nhiệt tình quá . hihi
@Chuot0106 : chức năng copyto của advanced filter tự dò tên cột trong vùng copyto , nó thấy tên cột nào "dính chấu" thì nó copy khỏi cần copy từng cột .
nghe truyền thuyết kể lại rằng dùng chức năng filter cho tốc độ nhanh hơn dùng vòng lặp .
nhưng trường hợp này cách dùng filter bị "kẹt" cái lệnh

.Range("A" & Rws).Resize(, 8).Delete Shift:=xlUp

đâm ra cuối cùng lại làm cho quá trình bị lâu hơn cách dùng vòng lặp

Mình dùng cách củ chuối trên(AutoFilter) mà thời gian chỉ bằng 1 nửa cách dùng advanceFilter mới lạ chứ!
Qua ví dụ trên mới thấy không hẳn nhiều vòng lặp mà đã chậm, code ngắn mà đã nhanh.

 

[phungtrangtt]

Cảm ơn bạn seikoqn và bạn doveandrose nhiều. File này đã làm đúng với yêu cầu của mình rồi. Cảm ơn mọi người đã giúp mình nha! Mình cũng muốn học VBA để có thể viết được như các bạn nhưng chắc khó lắm đây... nếu ai có tài liệu hay gì thì hướng dẫn giúp mình nha!

Một lần nữa cảm ơn các anh/chị/em giúp mình nhiều

 

[phungtrangtt]

Mọi người ơi, mình giữ nguyên file ma chèn nội dudung vào sheet còn lại. Save lại nhưng nó ko chạy. Mọi người hướng dẫn giúp

 

[phungtrangtt]

Hôm trước các bạn có hướng dẫn mình cách lọc dữ liệu. Tuy nhiên, do nhu cầu của công việc mình mong muốn thêm điều kiện lọc. Các bạn xem giúp mình điều chỉnh lại file nha! Cảm ơn mọi người rất nhiều