Lọc dữ liệu xuất hiện 1 lần (1 người xem)

Liên hệ QC

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

AndOrNot

Thành viên chính thức
Tham gia
27/6/12
Bài viết
75
Được thích
3
Chào các anh chị và các bạn trong ngôi nhà chung GPE.

Em có 1 vấn đề về Excel hiện chưa giải quyết được, mong mọi người xem và giúp đỡ.

Mô tả yêu cầu:
Sheet1 có cột A chứa mã hàng, trong đó các mã hàng này có thể lặp lại nhiều lần. Kết quả sẽ được thể hiện ở bên sheet2 trong đó thể hiện tất cả các mã hàng có nhưng chỉ xuất hiện 1 lần thôi.
(cái này có vẻ hơi giống privot table nhưng em muốn có cách nào đó mà không cần phải sử dụng các thao tác như vậy mà vẫn ra được kết quả theo đúng yêu cầu - ví dụ như việc sử dụng hàm, VBE, ...)

Cảm ơn các bạn đã ghé và chỉ giáo.

AndOrNot
 

File đính kèm

dùng hàm thử nha

A2=INDEX('Chi tiet'!$A$2:$A$41,MATCH(0,COUNTIF($A$1:A1,'Chi tiet'!$A$2:$A$41),0))

kết thúc bằng Ctrl Shift Enter
 
Lần chỉnh sửa cuối:
Upvote 0
Đứng tại Sheet Tong Hop, bạn vào Menu Data/ Filter/ Advanced Filter/ Chọn vùng dữ liệu cần lọc bên sheet chitiet, vùng dữ liệu đặt kết quả sau khi lọc và check vào mục : Unique record only ==> bấm OK
 
Upvote 0
dùng hàm thử nha
A2=INDEX('Chi tiet'!$A$2:$A$41,MATCH(0,COUNTIF($A$1:A1,'Chi tiet'!$A$2:$A$41),0))

kết thúc bằng Ctrl Shift Enter
Hoặc thế này :
PHP:
=INDEX('Chi tiet'!$A$2:$A$41,MATCH(TRUE,INDEX(ISNA(MATCH('Chi tiet'!$A$2:$A$41,$A$1:A1,0)),0),0))
Kết thúc bằng phím Enter
 
Upvote 0
Hix, Em cần cách làm bằng công thức, hàm, hay 1 cái gì đó mà không liên quan đến thao tác (có nghĩa là nó sẽ tự link sang sheet2 ngay sau khi cập nhật dữ liệu trong sheet1.
 
Upvote 0
Đứng tại Sheet Tong Hop, bạn vào Menu Data/ Filter/ Advanced Filter/ Chọn vùng dữ liệu cần lọc bên sheet chitiet, vùng dữ liệu đặt kết quả sau khi lọc và check vào mục : Unique record only ==> bấm OK


Hix, Em cần cách làm bằng công thức, hàm, hay 1 cái gì đó mà không liên quan đến thao tác (có nghĩa là nó sẽ tự link sang sheet2 ngay sau khi cập nhật dữ liệu trong sheet1.
 
Upvote 0
Hoặc thế này :
PHP:
=INDEX('Chi tiet'!$A$2:$A$41,MATCH(TRUE,INDEX(ISNA(MATCH('Chi tiet'!$A$2:$A$41,$A$1:A1,0)),0),0))
Kết thúc bằng phím Enter


Cảm ơn bác nhiều, đúng là ý của em rồi đó.

Nhân tiện nhờ bác giúp thêm cho em cái này để nó được tối ưu hơn:

1. Trong trường hơp, nếu dữ liệu ở sheet1 có sự ngắt quãng thì làm sao bên sheet2 vẫn hiểu được sự ngắt quãng đó sẽ không được tính là dữ liệu để xuất hiện.

2. Khi kéo công thức dài quá số lượng các mã thì nó sẽ thể hiện là khoảng trắng ("") chứ không phải thể hiện giá trị #N/A.

3. Ngoài việc đưa ra kết quả bên sheet2, thay vì đưa lần lượt theo thứ tự của sheet1 (chi tiết) thì kết quả bên sheet (tổng hợp) sẽ được tự động sắp xếp theo chiều tăng dần.

Một lần nữa em xin chân thành cảm ơn bác hoamattroicoi cũng như cảm ơn tất các bác khác đã dành chút thời gian ghé thăm và đọc chủ đề này của em.

AndOrNot
 
Upvote 0
Hix, Em cần cách làm bằng công thức, hàm, hay 1 cái gì đó mà không liên quan đến thao tác (có nghĩa là nó sẽ tự link sang sheet2 ngay sau khi cập nhật dữ liệu trong sheet1.
Vậy mình thử 1 cái gì đó cho bạn xem thử có hay hơn dùng công thức không nhé, đáp ứng được cả 3 cái yêu cầu bạn đưa ra, tốc độ chắc cũng k tồi lắm :
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row).Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
CODE sort :
PHP:
Private Function SortArr(sArr)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If Arr(i) > Arr(j) Then
            Tempt = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function
 

File đính kèm

Upvote 0
Vậy mình thử 1 cái gì đó cho bạn xem thử có hay hơn dùng công thức không nhé, đáp ứng được cả 3 cái yêu cầu bạn đưa ra, tốc độ chắc cũng k tồi lắm :
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row).Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
CODE sort :
PHP:
Private Function SortArr(sArr)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If Arr(i) > Arr(j) Then
            Tempt = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function

Cảm ơn bác nhiều lắm.

Làm phiền bác nhiều quá, nhưng vì em còn kém nên rất muốn học hỏi ở bác và tất cả các ACE khác trong GPE.

Trong trường hợp bây giờ em có 3 sheet chi tiết (chitiet1, chitiet2, chitiet3, và kết quả là sheet tonghop) - thay vì như trước chỉ có 1 sheet chitiet thôi. Bác giúp em với.

P/s: Ví dụ thể hiện chỉ vài chục dòng nhưng khi áp dụng vào file của em thì lên tới 20k dòng, vì vậy yếu tố về tốc độ xử lý cũng là 1 điều cần xem xét.

Cảm ơn bác nhiều

AndOrNot
 
Upvote 0
Trong trường hợp bây giờ em có 3 sheet chi tiết (chitiet1, chitiet2, chitiet3, và kết quả là sheet tonghop) - thay vì như trước chỉ có 1 sheet chitiet thôi. Bác giúp em với.
Quan trọng là 3 cái sheet chi tiết đó của bạn bố trí dữ liệu thế nào mới có thể giúp bạn được, nếu 3 sheet mà 3 vùng dữ liệu cần lọc duy nhất và sort nằm ở các cột khác nhau k tuân theo quy tắc nào thì hơi bị mệt đó. Túm lại thuật toán sẽ thêm 1 bước nữa là duyệt qua các sheet gom 3 cột đó lại nhét vào Array và nạp vào DIC hoặc duyệt qua các sheet rồi nhét thẳng các phần tử vào DIC luôn.

Tuy nhiên tôi cứ nói trước với bạn, thực tế và ví dụ nhiều khi là khác xa nhau vì bản thân bạn chưa hiểu về code nên khi lấy ví dụ có thể bị sót các trường hợp phát sinh, tốt nhất nên đưa file thật lên để mọi người có thể giúp bạn, khỏi mất công làm đi rồi lại sửa lại, rất mệt.
Nếu các dữ liệu nằm trên 1 cột nhất định thì bạn chỉnh code SortAndFill() thành thế này nhé.
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr(), tmpArr
Dim sH As Worksheet
Set Dic = CreateObject("Scripting.dictionary")
For Each sH In Worksheets
    If sH.Name <> "Tong hop" Then
        sArr = sH.Range("A2:A" & sH.[A65536].End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
                k = k + 1
                Dic.Add sArr(i, 1), ""
                ReDim Preserve dArr(1 To k)
                dArr(k) = sArr(i, 1)
            End If
        Next
    End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
Thuật toán như trên tôi đã đề xuất.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
1 cái gì đó cho bạn xem thử có hay hơn dùng công thức không nhé, đáp ứng được cả 3 cái yêu cầu bạn đưa ra, tốc độ chắc cũng k tồi lắm :
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row).Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
CODE sort :
PHP:
Private Function SortArr(sArr)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If Arr(i) > Arr(j) Then
            Tempt = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function

Chà Hoa Còi giỏi quá, thành cao thủ tầm cỡ rồi.}}}}}}}}}}}}}}}}}}}}
 
Upvote 0
Quan trọng là 3 cái sheet chi tiết đó của bạn bố trí dữ liệu thế nào mới có thể giúp bạn được, nếu 3 sheet mà 3 vùng dữ liệu cần lọc duy nhất và sort nằm ở các cột khác nhau k tuân theo quy tắc nào thì hơi bị mệt đó. Túm lại thuật toán sẽ thêm 1 bước nữa là duyệt qua các sheet gom 3 cột đó lại nhét vào Array và nạp vào DIC hoặc duyệt qua các sheet rồi nhét thẳng các phần tử vào DIC luôn.

Tuy nhiên tôi cứ nói trước với bạn, thực tế và ví dụ nhiều khi là khác xa nhau vì bản thân bạn chưa hiểu về code nên khi lấy ví dụ có thể bị sót các trường hợp phát sinh, tốt nhất nên đưa file thật lên để mọi người có thể giúp bạn, khỏi mất công làm đi rồi lại sửa lại, rất mệt.
Nếu các dữ liệu nằm trên 1 cột nhất định thì bạn chỉnh code SortAndFill() thành thế này nhé.
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr(), tmpArr
Dim sH As Worksheet
Set Dic = CreateObject("Scripting.dictionary")
For Each sH In Worksheets
    If sH.Name <> "Tong hop" Then
        sArr = sH.Range("A2:A" & sH.[A65536].End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
                k = k + 1
                Dic.Add sArr(i, 1), ""
                ReDim Preserve dArr(1 To k)
                dArr(k) = sArr(i, 1)
            End If
        Next
    End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
Thuật toán như trên tôi đã đề xuất.

Em cảm ơn bác nhiều. Hâm mộ bác quá, bác cho em số đt của bác để có dịp em được làm phiền nhe!

AndOrNot
 
Upvote 0
Upvote 0
Bài đó có đọc rồi mà có ai hiểu bạn nói cái gì đâu mà giúp

Chào bác ndu96081631, trong nội dung của vấn đề ở topic kia thì em muốn link 1 file excel của mình với 1 giá trị, hay 1 đoạn code nào đó với 1 file trực tuyến lưu trữ. Điều này giống như sử dụng Add-Ins nhưng cái Add-Ins đó được lưu trực tuyến. Giả sử trong file Excel (hoặc code VBA của em có dòng "If a=1 Then b=2", khi đó dòng lệnh này sẽ được link đến 1 dữ liệu trực tuyến và giá trị a em có thể thay đổi trực tuyến). Có thể em nói dài dòng và khó hiểu quá nhưng cũng vẫn rất mong các bác sẽ hiểu được ý của em và giúp em.

AndOrNot
 
Upvote 0
Vậy mình thử 1 cái gì đó cho bạn xem thử có hay hơn dùng công thức không nhé, đáp ứng được cả 3 cái yêu cầu bạn đưa ra, tốc độ chắc cũng k tồi lắm :
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Sheet1.Range("A2:A" & Sheet1.[A65536].End(3).Row).Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
CODE sort :
PHP:
Private Function SortArr(sArr)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If Arr(i) > Arr(j) Then
            Tempt = Arr(j)
            Arr(j) = Arr(i)
            Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function


Bác ơi!
Nếu cũng là yêu cầu và mục đích như vậy, có thể sử dụng hàm tự tạo được không bác (file đính kèm)
 

File đính kèm

Upvote 0
Gửi bạn AndOrNot :
PHP:
Function SortAndFill(Rng As Range, c As Integer)
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Rng.Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
If c = 1 Then dArr = SortarrAS(dArr)
If c = -1 Then dArr = SortarrDS(dArr)
If c = 0 Then GoTo 1
1:
For i = k + 1 To UBound(sArr)
  ReDim Preserve dArr(1 To i)
  dArr(i) = ""
Next i
SortAndFill = Application.Transpose(dArr)
Set Dic = Nothing
End Function
Trong file đính kèm còn 2 đoạn code để sắp xếp tăng dần và giảm dần, bạn xem chi tiết cách sử dụng hàm trong file nhé.
 

File đính kèm

Lần chỉnh sửa cuối:
Upvote 0
PHP:
Function SortAndFill(Rng As Range, c As Integer)

Nên đổi thành

PHP:
Function SortAndFill(Rng As Range, Optional SmallToLarge As Boolean=True)

sẽ thuận lợi hơn, và có thể gộp 2 hàm sortArr thành mod cũng với tham số như thế
 
Lần chỉnh sửa cuối:
Upvote 0
Gửi bạn AndOrNot :
PHP:
Function SortAndFill(Rng As Range, c As Integer)
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Rng.Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
If c = 1 Then dArr = SortarrAS(dArr)
If c = -1 Then dArr = SortarrDS(dArr)
If c = 0 Then GoTo 1
1:
For i = k + 1 To UBound(sArr)
  ReDim Preserve dArr(1 To i)
  dArr(i) = ""
Next i
SortAndFill = Application.Transpose(dArr)
Set Dic = Nothing
End Function
Trong file đính kèm còn 2 đoạn code để sắp xếp tăng dần và giảm dần, bạn xem chi tiết cách sử dụng hàm trong file nhé.

Bài viết trên nhầm, như vậy c có 3 khả năng vậy thì phải dùng biến interger là chuẩn

Tuy vậy có thể cải tiến 1 chút như sau,

giờ chỉ cần 2 hàm,

PHP:
Function SortAndFill(Rng As Range, Optional MyChoice As Integer = 0)
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr()
Set Dic = CreateObject("Scripting.dictionary")
sArr = Rng.Value
For i = 1 To UBound(sArr)
If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
    k = k + 1
    Dic.Add sArr(i, 1), ""
    ReDim Preserve dArr(1 To k)
    dArr(k) = sArr(i, 1)
End If
Next
Set Dic = Nothing

If MyChoice = 1 Or MyChoice = -1 Then dArr = SortArr(dArr, MyChoice = 1)
ReDim Preserve dArr(1 To UBound(sArr))
For i = k + 1 To UBound(sArr): dArr(i) = "": Next i

SortAndFill = Application.Transpose(dArr)
End Function

'''---------------------------------------------------------------------------
Private Function SortArr(sArr, Optional SmallToLarge As Boolean = True)
Dim Arr
Dim i As Long
Dim j As Long
Dim Lb As Long
Dim n As Long
Dim Tempt
Arr = sArr
n = UBound(Arr)
Lb = LBound(Arr)
For i = Lb To n - 1
    For j = i + 1 To n
        If (SmallToLarge And Arr(i) > Arr(j)) Or _
            (Not SmallToLarge And Arr(i) < Arr(j)) Then
            Tempt = Arr(j): Arr(j) = Arr(i):    Arr(i) = Tempt
        End If
    Next j
Next i
SortArr = Arr
End Function
 
Upvote 0
Quan trọng là 3 cái sheet chi tiết đó của bạn bố trí dữ liệu thế nào mới có thể giúp bạn được, nếu 3 sheet mà 3 vùng dữ liệu cần lọc duy nhất và sort nằm ở các cột khác nhau k tuân theo quy tắc nào thì hơi bị mệt đó. Túm lại thuật toán sẽ thêm 1 bước nữa là duyệt qua các sheet gom 3 cột đó lại nhét vào Array và nạp vào DIC hoặc duyệt qua các sheet rồi nhét thẳng các phần tử vào DIC luôn.

Tuy nhiên tôi cứ nói trước với bạn, thực tế và ví dụ nhiều khi là khác xa nhau vì bản thân bạn chưa hiểu về code nên khi lấy ví dụ có thể bị sót các trường hợp phát sinh, tốt nhất nên đưa file thật lên để mọi người có thể giúp bạn, khỏi mất công làm đi rồi lại sửa lại, rất mệt.
Nếu các dữ liệu nằm trên 1 cột nhất định thì bạn chỉnh code SortAndFill() thành thế này nhé.
PHP:
Sub SortAndFill()
Dim i As Long, k As Long
Dim Dic As Object, sArr(), dArr(), tmpArr
Dim sH As Worksheet
Set Dic = CreateObject("Scripting.dictionary")
For Each sH In Worksheets
    If sH.Name <> "Tong hop" Then
        sArr = sH.Range("A2:A" & sH.[A65536].End(3).Row).Value
        For i = 1 To UBound(sArr)
            If Not IsEmpty(sArr(i, 1)) And Not Dic.exists(sArr(i, 1)) Then
                k = k + 1
                Dic.Add sArr(i, 1), ""
                ReDim Preserve dArr(1 To k)
                dArr(k) = sArr(i, 1)
            End If
        Next
    End If
Next
dArr = SortArr(dArr)
Sheet2.[A2:A100].ClearContents
Sheet2.[A2].Resize(k, 1) = Application.Transpose(dArr)
Set Dic = Nothing
End Sub
Thuật toán như trên tôi đã đề xuất.
Sao mình ứng dụng không được vậy bạn ( sheet 2)
 

File đính kèm

Upvote 0
Sao mình ứng dụng không được vậy bạn ( sheet 2)

Bạn chọn cả vùng cần đặt kết quả --> Gõ công thức (hàm tự tạo) theo đúng cú pháp --> Ctrl Shift Enter --> OK

Cách làm của bạn không cho ra kết quả: Chọn 1 ô dữ liệu đặt kết quả --> Gõ công thức --> Ctrl Shift Enter --> Kéo công thức ?
 
Lần chỉnh sửa cuối:
Upvote 0
Bác vodoi2x
user-offline.png
Nothing & Nothing ơi giúp em làm Macro thay vì phải làm tay giống như trong yêu cầu sheet note được không.e lam hoài không được.
hoac link:
http://www.mediafire.com/view/?ssb9ycuubpta9s9
 
Lần chỉnh sửa cuối:
Upvote 0

Bài viết mới nhất

Back
Top Bottom