Hỏi về trích lọc dữ liệu duy nhất từ một mảng (6 người xem)

[concogia]

SPCG xem lại giúp mình ,sao cái Code trên nó hoạt động trong Sheet"NoiDung" ko đúng?Thank

Híc, trong sheet "NoiDung" bạn phải khai báo vùng dữ liệu ( trong code là biến "Vung") là:

Vung = Sheets("F").Range(Sheets("F").[AR6], Sheets("F").[AR10000].End(xlUp)).Resize(,12)

Vì vùng dữ liệu lớn hơn 1 cột, bạn phải cho chạy 2 biến, nhưng trong bài chỉ cần lọc duy nhất & sắp xếp theo bảng có trước nên chỉ cần dùng For Each chạy hết biến "Vung"
Híc, mình gợi ý thế, bạn khamha thử sửa code xem có được không, nếu "tèo" thì tý nữa mình làm cho, để đi tắm một cái, nóng quá, Sì- Gòn hôm nay nóng "kinh khủng khiếp", bên Lào có nóng hông ??????
Thân

 

[concogia]

Code nó đây:

Private Sub CommandButton1_Click()
Dim NoiDung As Range, Vung As Variant, I, K As Long, d As Object, Hang As Long, Tam As Variant, Kq As Variant
    Set d = CreateObject("scripting.dictionary")
    Set NoiDung = Sheets("F").Range(Sheets("F").[BR6], Sheets("F").[BR10000].End(xlUp))
    ReDim Tam(1 To NoiDung.Rows.Count, 1 To 1)
    Vung = Sheets("F").Range(Sheets("F").[AR6], Sheets("F").[AR10000].End(xlUp)).Resize(, 12)
        For Each I In Vung
            If I <> "." Then
                If Not d.exists(I) Then
                    Hang = Application.WorksheetFunction.Match(I, NoiDung, 0)
                    d.Add I, ""
                    Tam(Hang, 1) = I
                End If
            End If
        Next I
            ReDim Kq(1 To NoiDung.Rows.Count, 1 To 1)
            For I = 1 To NoiDung.Rows.Count
                If Tam(I, 1) <> "" Then
                    K = K + 1
                    Kq(K, 1) = Tam(I, 1)
                End If
            Next I
    Sheets("noidung").[D10].Resize(K, 1) = Kq
End Sub

Thân

 

[khamha]

Nếu thể thì khí hậu ở SG và Lào giống nhau rồi,Cũng đang rất nóng nhưng đang đi a lếc anh em nên ko tắm được,ko biết khi nào có cơ hội được đàm tửu với SPCG. ko biết tửu lượng của SP cón chiến đấu được lít ko?

 

[khamha]

Được voi đòi tiên.

Bài này còn nhiều vấn đề chưa hiểu lắm, làm tạm thôi, xỉn quá rồi
Bạn kiểm tra giúp
Thân

Nhờ SPCG phang vào mấy cái Sheet báo cáo để cho nó tự động tính tổng luôn (ko dùng công thức nữa) đã lỡ Code thì cho nó Code hết luôn ,Thank SPCG

 

[Ba Tê]

Híc, tưng quá
Không cần sort đâu bạn già Ba Tê ạ, nên không quan tâm sắp xếp theo kiểu số hay chuỗi. Ta sắp xếp theo bảng dữ liệu cho trước, trong bài là 3 bảng "Nội dung" , "Quy cách", "Bộ phận"
Mỗi người có một cách giải khác nhau, mình thì làm theo kiểu thế này, thí dụ với "Quy cách"
Tạo nút bấm ở sheet "Quycach" ( đây chỉ là ví dụ, bạn có thể chạy code tùy ý) chạy code này:

Private Sub CommandButton1_Click()
    Dim QuyCach As Range, Vung As Variant, I As Long, K As Long, d As Object, Hang As Long, Tam As Variant, Kq As Variant
    Set d = CreateObject("scripting.dictionary")
    Set QuyCach = Sheets("F").Range(Sheets("F").[BT6], Sheets("F").[BT10000].End(xlUp))
    ReDim Tam(1 To QuyCach.Rows.Count, 1 To 1)
    Vung = Sheets("F").Range(Sheets("F").[AG6], Sheets("F").[AG10000].End(xlUp))
        For I = 1 To UBound(Vung)
            If Not d.exists(Vung(I, 1)) Then
                Hang = Application.WorksheetFunction.Match(Vung(I, 1), QuyCach, 0)
                d.Add Vung(I, 1), ""
                Tam(Hang, 1) = Vung(I, 1)
            End If
        Next I
            ReDim Kq(1 To QuyCach.Rows.Count, 1 To 1)
            For I = 1 To QuyCach.Rows.Count
                If Tam(I, 1) <> "" Then
                    K = K + 1
                    Kq(K, 1) = Tam(I, 1)
                End If
            Next I
    Sheets("quycach").[D10].Resize(K, 1) = Kq
End Sub

Tưng quá, làm một cái thôi, 2 cái còn lại tương tự, riêng mấy cái thằng a1, a2..............phải thêm điều kiện khác dấu chấm (".")
Nếu trúng thì tốt, hổng trúng thì bạn khamha nhờ thầy Ba Tê giúp tiếp nhé, hihi
Híc
Thân

Vậy là tới giờ tui vẫn chưa hiểu câu hỏi.
Híc! Cò Già hay thiệt.

 

[truong84]

Anh chị thân mến!
Anh chị cho em hỏi. em muốn lọc lấy nội dung công việc theo từng ngày thì làm thế nào được ạ, nhờ anh chị chỉ giúp
em cảm ơn anh chị!View attachment Loc lay noi dung theo ngay.xlsx

 

[Ba Tê]

Nhờ SPCG phang vào mấy cái Sheet báo cáo để cho nó tự động tính tổng luôn (ko dùng công thức nữa) đã lỡ Code thì cho nó Code hết luôn ,Thank SPCG

Bạn muốn "phang" mà phang vào đâu, cột nào, lấy tổng ở đâu, lấy ra sao....
Bạn đưa file mẫu có giải thích và kết quả muốn có lên đi.

 

[Ba Tê]

Anh chị thân mến!
Anh chị cho em hỏi. em muốn lọc lấy nội dung công việc theo từng ngày thì làm thế nào được ạ, nhờ anh chị chỉ giúp
em cảm ơn anh chị!View attachment 102309

Hỏi kiểu này sao khó hiểu quá.
Bạn cho kết quả bạn muốn có cho ngày 27 vào ô J2 và ngày 28 vào ô J3 xem nó ra sao.

 

[khamha]

Bạn muốn "phang" mà phang vào đâu, cột nào, lấy tổng ở đâu, lấy ra sao....
Bạn đưa file mẫu có giải thích và kết quả muốn có lên đi.

Chà mình sơ xuất quá...đã phạm quy ,mình đã up File muốn "phang"...(những dòng chữ màu xanh,có công thức:là những chỗ muốn thay thế bằng Code) .Thank

 

[khamha]

Chà mình sơ xuất quá...đã phạm quy ,mình đã up File muốn "phang"...(những dòng chữ màu xanh,có công thức:là những chỗ muốn thay thế bằng Code) .Thank

Ko biết hai SPCG & BT "phang" đến đâu rồi ta.

 

[vnlife2000]

Muốn giữ nguyên định dạng sau khi paste thì phải làm sao ạ?

Vầy cũng ngắn nè.

Sub loc()
Dim data(), item
data = [A5].Resize(65000, 10).Value
With CreateObject("scripting.dictionary")
   For Each item In data
      If item <> "" Then
         If Not .exists(item) Then .Add item, ""
      End If
   Next
   [K5].Resize(.Count) = Application.Transpose(.keys)
End With
End Sub

PS: Theo kinh nghiệm thì chịu khó dùng 2 lần If, tránh dùng And thì tốc độ cải thiện đáng kể

 

[ndu96081631]

Muốn giữ nguyên định dạng sau khi paste thì phải làm sao ạ?

Để giữ nguyên định dạng, không gì bằng ta dùng Advanced Filter

 

[vnlife2000]

Mình có 2 sheet khác nhau bạn ah, mình có dùng mảng khai báo trong Nam manager nhưng khi chạy rất là chậm, dùng code ở trên chạy rất là nhanh nhưng code trên không giữ định dạng, có cách nào giúp mình code lại không ạ. cảm ơn mọi người.

 

[genius111]

Dùng cái này:

Function UniqueList(ParamArray sArray())
  Dim Item, tmpArr, SubArr, tmp
  'On Error Resume Next
  With CreateObject("Scripting.Dictionary")
    For Each SubArr In sArray
      tmpArr = SubArr
      If Not IsArray(tmpArr) Then tmpArr = Array(tmpArr)
      For Each Item In tmpArr
        tmp = CStr(Item)
        If Len(tmp) Then
          If Not .Exists(tmp) Then .Add tmp, ""
        End If
      Next
    Next
    If .Count Then UniqueList = .Keys
  End With
End Function
Sub Main()
  Dim Arr
  With Sheet1
    .Range("K5:K10000").ClearContents
    Arr = UniqueList(.Range("A5:J10000"))
    If IsArray(Arr) Then .Range("K5").Resize(UBound(Arr) + 1).Value = WorksheetFunction.Transpose(Arr)
  End With
End Sub

Chạy Sub Main sẽ có kết quả

Thầy Ndu cho em hỏi trường hợp của em là trích lọc duy nhất theo điều kiện sang 1 sheet khác, ví dụ em muốn trích lọc duy nhất các giá trị liên quan đến "Gói 1" thì các dữ liệu liên quan đến "Gói 1" sẽ được trích lọc duy nhất sang sheet khác. Em thử sửa code Main của thầy thành
if Arr = Dkien loc and IsArray(Arr) then .... nhưng mà bị lỗi, em gửi File thầy xem giúp em, em cảm ơn!

 

[genius111]

Chi khổ vậy. Dùng Advanced Filter trong vòng 3 nốt nhạc cho nhanh!

thanks anh, nhưng vì em mới học về mảng nên muốn luyện thêm, thấy đoạn code của thầy Ndu tuy có hơi dài nhưng có thể vận dụng cho nhiều trường hợp vì chỉ cần sửa sub main là được, cơ mà tư duy em có hạn nên gặp bài toán có hơi thay đổi chút xíu mà chưa xoay sở được

 

[genius111]

a

Muốn học mảng thì vầy.

Public Sub GPE()
Dim Dic As Object, I As Long, K As Long, Tmp As String, Arr, dArr, Goi As String
Arr = Sheet1.Range("A1").CurrentRegion.Value "Vùng dữ liệu nguồn, lấy luôn cả tiêu đề -> tương ứng với chuột đang đặt tại A1 và nhấn Ctrl+Shift+*
ReDim dArr(1 To UBound(Arr), 1 To 1)
Goi = Sheet2.Range("A2").Value
Set Dic = CreateObject("Scripting.Dictionary")
    For I = 2 To UBound(Arr) "Duyệt từ dòng 2 của vùng dữ liệu đến hết.
        If Arr(I, 5) = Goi Then "Nếu cột 5 trong vùng dữ liệu bằng GÓI
        Tmp = Arr(I, 4) 'Cột 4 trong vùng dữ liệu
            If Not Dic.Exists(Tmp) Then
                K = K + 1
                Dic.Add Tmp, K
                dArr(K, 1) = Tmp
            End If
        End If
    Next
With Sheet2
    .Range("A4").Resize(1000).ClearContents
    .Range("A4").Resize(K) = dArr
End With
End Sub

anh ơi, code bị báo lỗi chỗ .Range("A4").Resize(K) = dArr

 

[PacificPR]

a

anh ơi, code bị báo lỗi chỗ .Range("A4").Resize(K) = dArr

Bạn thay lại là .Range("A4").Resize(K,1) = dArr

 

[genius111]

Bạn thay lại là .Range("A4").Resize(K,1) = dArr

cảm ơn bác nhưng em thay lại rồi mà vẫn bị báo lỗi dòng đó

 

[genius111]

Không cần thiết vì mảng dArr có 1 cột nhé.


Chữ Gói 01 tại A2 khác với bên dữ liệu. bạn kiểm tra kỹ lại nhé... (copy paste value từ bên dữ liệu sang ô A2 và chạy lại code nhé)

Hix, em sai cơ bản quá, đúng là em gõ sai thật, em cảm ơn bác hpkhuong nhiều

 

[huongmuine]

NHờ các anh chị viết giúp code bằng sự kiện "Private Sub Worksheet_Change"
-Lọc duy nhất và xếp thứ tự theo năm sinh.
- Đếm số lượng trên nữ
Kết quả ở vùng tô vàng.
Xin cảm ơn.