Lọc dự liệu với hai điều kiện (5 người xem)

[tiny1010]

Dear All

Mình có một bảng có 3 cột: cột thứ nhất là tên, cột thứ hai là loại cột thứ 3 là nội dung

Mình muốn chuyển thành một bảng có cột thứ nhất là tên các cột tiếp theo là lần lượt các loại

Các bác giúp giùm minh nha

 

[Hai Lúa Miền Tây]

Dear All

Mình có một bảng có 3 cột: cột thứ nhất là tên, cột thứ hai là loại cột thứ 3 là nội dung

Mình muốn chuyển thành một bảng có cột thứ nhất là tên các cột tiếp theo là lần lượt các loại

Các bác giúp giùm minh nha

Cho mình hỏi thêm là cột số 3 (Cột So) là cột chứa text hay là số vậy bạn ?

 

[ndu96081631]

Dear All

Mình có một bảng có 3 cột: cột thứ nhất là tên, cột thứ hai là loại cột thứ 3 là nội dung
Mình muốn chuyển thành một bảng có cột thứ nhất là tên các cột tiếp theo là lần lượt các loại
Các bác giúp giùm minh nha

Hỏi lại:
- Có trường hợp nào trùng TÊN và LOẠI hay không?
- Nếu có trường hợp này thì số lượng có được cộng dồn hay không?

 

[tiny1010]

dự liệu cột số 3 chứa dự liệu bất kỳ

 

[tiny1010]

Hỏi lại:
- Có trường hợp nào trùng TÊN và LOẠI hay không?
- Nếu có trường hợp này thì số lượng có được cộng dồn hay không?

Nếu cùng tên thì sẽ không có loại trùng nhau

 

[ndu96081631]

Cho mình hỏi thêm là cột số 3 (Cột So) là cột chứa text hay là số vậy bạn ?

Ẹc... Ẹc... Doom hỏi vậy chắc định dùng PivotTable đây (nếu cột D toàn Number)
---------------------------------

Nếu cùng tên thì sẽ không có loại trùng nhau

Làm thử cho bạn bằng công thức đây!
Xem file
(Bài này dùng VBA thì khỏe hơn)

 

[tiny1010]

Ẹc... Ẹc... Doom hỏi vậy chắc định dùng PivotTable đây (nếu cột D toàn Number)
---------------------------------

Làm thử cho bạn bằng công thức đây!
Xem file
(Bài này dùng VBA thì khỏe hơn)

Cám ơn bạn nhiều, nhưng sa minh click vô coi công thứ sau do enter thì nó lại lổi vậy???

 

[ndu96081631]

Cám ơn bạn nhiều, nhưng sa minh click vô coi công thứ sau do enter thì nó lại lổi vậy???

Vì đó là công thức mảng ---> Phải Ctrl + Shift + Enter mới được (Enter sẽ lổi)

 

[tam8678]

(Bài này dùng VBA thì khỏe hơn)

---

Làm cho anh học được không chú?

 

[tiny1010]

Vì đó là công thức mảng ---> Phải Ctrl + Shift + Enter mới được (Enter sẽ lổi)

Hay quá cám ơn bạn nhiều!!!!

 

[ndu96081631]

---

Làm cho anh học được không chú?

Anh thử file này xem
- Khi bấm nút "Chạy code" 1 InputBox hiện ra, anh chọn cell đầu tiên, nơi anh sẽ đặt dữ liệu kết quả
- Khi InputBox thứ 2 xuất hiện, anh quét chọn vùng dữ liệu gốc (kể cả tiêu đề)
- Bấm OK và kiểm tra kết quả
------------
Code này dành cho dạng dữ liệu tương tự như tác giả đã đưa lên, tức gồm 3 cột.. với 2 cột đầu dùng làm tiêu đề và cột thứ 3 là dữ liệu cần tổng hợp!

 

[Hai Lúa Miền Tây]

Em xin thêm hàm khử lỗi #N/A nếu như dò không có thì cho nó là trống.

Sub Test()
  Dim Des As Range, Src As Range, Clls As Range, Tmp1 As String, Tmp2 As String
  Dim Title1 As Range, Title2 As Range, Title3 As Range
  On Error GoTo ExitSub
  Set Des = Application.InputBox("Chon cell dau tien, noi dat du lieu", Type:=8)
  Set Src = Application.InputBox("Chon vung du lieu goc", Type:=8)
  Set Title1 = Src.Offset(0, 0).Resize(, 1)
  Set Title2 = Src.Offset(0, 1).Resize(, 1)
  Set Title3 = Src.Offset(0, 2).Resize(, 1)
  Des.Resize(UBound(UniqueList(Title1)) + 1).Value = WorksheetFunction.Transpose(UniqueList(Title1))
  Des.Resize(, UBound(UniqueList(Title2)) + 1).Value = UniqueList(Title2)
  With Des.CurrentRegion
    For Each Clls In Intersect(.Cells, .Offset(1, 1))
      Tmp1 = Intersect(Des.EntireColumn, Clls.EntireRow).Address
      Tmp2 = Intersect(Des.EntireRow, Clls.EntireColumn).Address
      Clls.Value = Evaluate("INDEX(" & Title3.Address & ",Match(" & Tmp1 & "&" & Tmp2 & "," & Title1.Address & "&" & Title2.Address & ",0))")
     [COLOR=Blue][B] If IsError(Clls) Then
         Clls.Value = ""
      End If[/B][/COLOR]
    Next
    Des = Title1(1, 1)
  End With
ExitSub:
End Sub

 

[ndu96081631]

Code trên dùng ít nhất là 3 lần lập: 1 lần trong code chính và 2 lần trong UDF ---> Tôi cảm thấy như vậy là quá thừa
Cải tiến lần nữa, dùng duy nhất 1 lần lập và không cần sự trợ giúp của hàm tự tạo
1> Đây là phương pháp thông thường: Tìm đến đâu, điền dữ liệu đến nấy

Sub Transfer()
  Dim Des As Range, Src As Range, Clls As Range
  Dim Dic1, Dic2, i As Long, j As Long
  On Error GoTo ExitSub
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  Set Src = Application.InputBox("Chon vung du lieu goc, bao gom ca tieu de", Type:=8)
  Set Des = Application.InputBox("Chon cell dau tien, noi dat du lieu", Type:=8)(1, 1)
  For Each Clls In Intersect(Src, Src.Offset(1)).Resize(, 1)
    If Not Dic1.Exists(Clls(, 1).Value) Then
      i = i + 1: Dic1.Add Clls(, 1).Value, i
      Des.Offset(i) = Clls(, 1)
    End If
    If Not Dic2.Exists(Clls(, 2).Value) Then
      j = j + 1: Dic2.Add Clls(, 2).Value, j
      Des.Offset(, j) = Clls(, 2)
    End If
    Des.Offset(Dic1.Item(Clls(, 1).Value), Dic2.Item(Clls(, 2).Value)) = Clls(, 3)
  Next
  Des = Src(1, 1)
ExitSub:
End Sub

2> Đây là phương pháp dùng mảng nạp toàn bộ dữ liệu tìm được vào mảng, cuối cùng gán mảng vào vùng kết quả

Sub Transfer()
  Dim Des As Range, Src As Range, Clls As Range
  Dim Dic1, Dic2, i As Long, j As Long, Arr(100, 100)
  On Error GoTo ExitSub
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  Set Src = Application.InputBox("Chon vung du lieu goc, bao gom ca tieu de", Type:=8)
  Set Des = Application.InputBox("Chon cell dau tien, noi dat du lieu", Type:=8)
  Arr(0, 0) = Src(1, 1)
  For Each Clls In Intersect(Src, Src.Offset(1)).Resize(, 1)
    If Not Dic1.Exists(Clls(, 1).Value) Then
      i = i + 1: Dic1.Add Clls(, 1).Value, i
      Arr(i, 0) = Clls(, 1)
    End If
    If Not Dic2.Exists(Clls(, 2).Value) Then
      j = j + 1: Dic2.Add Clls(, 2).Value, j
      Arr(0, j) = Clls(, 2)
    End If
    Arr(Dic1.Item(Clls(, 1).Value), Dic2.Item(Clls(, 2).Value)) = Clls(, 3)
  Next
  Des.Resize(Dic1.Count + 1, Dic2.Count + 1).Value = Arr
ExitSub:
End Sub

Ai rảnh rổi hãy thử nghiệm xem phương pháp dùng mảng có nhanh hơn không nha!
------------------------------
Gữi Domfootwear: Dữ liệu giả lập bạn đưa trong file là chưa hợp lý nha! Ngay từ đầu tôi đã hỏi và tác giả cũng đã khẳng định rằng không có dữ liệu trùng ---> Vì nếu có dữ liệu trùng thì làm sao TỔNG HỢP được
Tóm lại: Có thể thiếu 1 Item nào đó nhưng không thể có chuyện TRÙNG

 

[tiny1010]

Một vấn đề nhỏ mình đưa ra nhưng lại được các bạn chỉ giúp tận tình, giúp mình hiểu ra nhiều thứ. Cám ơn các bạn nhiều

 

[wwwgiaiphapexcelcom]

Code trên dùng ít nhất là 3 lần lập: 1 lần trong code chính và 2 lần trong UDF ---> Tôi cảm thấy như vậy là quá thừa
Cải tiến lần nữa, dùng duy nhất 1 lần lập và không cần sự trợ giúp của hàm tự tạo
1> Đây là phương pháp thông thường: Tìm đến đâu, điền dữ liệu đến nấy

Sub Transfer()
  Dim Des As Range, Src As Range, Clls As Range
  Dim Dic1, Dic2, i As Long, j As Long
  On Error GoTo ExitSub
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  Set Src = Application.InputBox("Chon vung du lieu goc, bao gom ca tieu de", Type:=8)
  Set Des = Application.InputBox("Chon cell dau tien, noi dat du lieu", Type:=8)(1, 1)
  For Each Clls In Intersect(Src, Src.Offset(1)).Resize(, 1)
    If Not Dic1.Exists(Clls(, 1).Value) Then
      i = i + 1: Dic1.Add Clls(, 1).Value, i
      Des.Offset(i) = Clls(, 1)
    End If
    If Not Dic2.Exists(Clls(, 2).Value) Then
      j = j + 1: Dic2.Add Clls(, 2).Value, j
      Des.Offset(, j) = Clls(, 2)
    End If
    Des.Offset(Dic1.Item(Clls(, 1).Value), Dic2.Item(Clls(, 2).Value)) = Clls(, 3)
  Next
  Des = Src(1, 1)
ExitSub:
End Sub

2> Đây là phương pháp dùng mảng nạp toàn bộ dữ liệu tìm được vào mảng, cuối cùng gán mảng vào vùng kết quả

Sub Transfer()
  Dim Des As Range, Src As Range, Clls As Range
  Dim Dic1, Dic2, i As Long, j As Long, Arr(100, 100)
  On Error GoTo ExitSub
  Set Dic1 = CreateObject("Scripting.Dictionary")
  Set Dic2 = CreateObject("Scripting.Dictionary")
  Set Src = Application.InputBox("Chon vung du lieu goc, bao gom ca tieu de", Type:=8)
  Set Des = Application.InputBox("Chon cell dau tien, noi dat du lieu", Type:=8)
  Arr(0, 0) = Src(1, 1)
  For Each Clls In Intersect(Src, Src.Offset(1)).Resize(, 1)
    If Not Dic1.Exists(Clls(, 1).Value) Then
      i = i + 1: Dic1.Add Clls(, 1).Value, i
      Arr(i, 0) = Clls(, 1)
    End If
    If Not Dic2.Exists(Clls(, 2).Value) Then
      j = j + 1: Dic2.Add Clls(, 2).Value, j
      Arr(0, j) = Clls(, 2)
    End If
    Arr(Dic1.Item(Clls(, 1).Value), Dic2.Item(Clls(, 2).Value)) = Clls(, 3)
  Next
  Des.Resize(Dic1.Count + 1, Dic2.Count + 1).Value = Arr
ExitSub:
End Sub

Ai rảnh rổi hãy thử nghiệm xem phương pháp dùng mảng có nhanh hơn không nha!
------------------------------
Gữi Domfootwear: Dữ liệu giả lập bạn đưa trong file là chưa hợp lý nha! Ngay từ đầu tôi đã hỏi và tác giả cũng đã khẳng định rằng không có dữ liệu trùng ---> Vì nếu có dữ liệu trùng thì làm sao TỔNG HỢP được
Tóm lại: Có thể thiếu 1 Item nào đó nhưng không thể có chuyện TRÙNG

*****************
Chào bạn,

Mình đã thử 2 cách với data 400.000 dòng và 3 cột thì cách 1 chay ok nhưng rất lâu. Còn cách 2 không chạy được.
Mình thử lại với khoang 100 dòng thì ok. Còn hơn thì không được.
Cảm ơn bạn.

 

[syhoang24]

Công thức của bạn đúng rồi, đâu cần phải làm bằng VBA cho phức tạp vì có thể có người còn chưa biết tới VBA mà.
Tuy nhiên công thức của Ndu96081631 nếu khi không nhập điều kiện tham chiếu thì sẽ báo về lỗi #N/A, trông không bắt mắt tí nào cả.
Mình xin bổ sung có gì các bạn cho ý kiến nha

 

[xuantamc6]

Hỏi lại:
- Có trường hợp nào trùng TÊN và LOẠI hay không?
- Nếu có trường hợp này thì số lượng có được cộng dồn hay không?

Nếu trường hợp trùng nhau rồi cộng dồn thì mình sẽ phải làm như thế nào bác ạ?

 

[be_09]

---

Làm cho anh học được không chú?

Cùng là dân Biên Hòa nhưng chưa thấy 1 lần Coffee sáng thứ bảy, chúa nhật với hội Trà tam (ndu, Lê Duy Thương, be09) vậy bạn tham gia cho thành hội Rượu tứ, ông bà xưa thường nói "trà tam, rượu tứ".