Lấy dữ liệu không bị lặp lại (6 người xem)

[Phamanh1998]

Em chào anh chị, hiện nay trong bảng dữ liệu liệu bị trùng lập (Dữ liệu theo cột). Anh/chị cho em hỏi có công thức nào để loại bỏ các dữ liệu trùng và đưa ra kết quả các dữ liệu đó được không ạ. Em mong được anh/chị giúp đỡ. Em cảm ơn anh chị ạ

 

[Quang_Hải]

Em chào anh chị, hiện nay trong bảng dữ liệu liệu bị trùng lập (Dữ liệu theo cột). Anh/chị cho em hỏi có công thức nào để loại bỏ các dữ liệu trùng và đưa ra kết quả các dữ liệu đó được không ạ. Em mong được anh/chị giúp đỡ. Em cảm ơn anh chị ạ

Tạm thời xử lý bằng VBA. Hóng cách giải bằng công thức

 

[Phamanh1998]

Tạm thời xử lý bằng VBA. Hóng cách giải bằng công thức

Em cảm ơn anh ạ, nếu được mong anh chị hỗ trợ em bằng công thức ạ vì VBA với em giờ hơi khó hiểu ạ. Em cảm ơn anh chị ạ

Bài đã được tự động gộp: 1/2/21

Tạm thời xử lý bằng VBA. Hóng cách giải bằng công thức

Anh cho em hỏi thêm một chút là nếu dùng VBA như trên mà em muốn hiện thị kết quả ở sheet khác thì chỉnh sửa cột thế nào ạ, mong anh hướng dẫn em ạ. Em cảm ơn anh

 

[Quang_Hải]

Em cảm ơn anh ạ, nếu được mong anh chị hỗ trợ em bằng công thức ạ vì VBA với em giờ hơi khó hiểu ạ. Em cảm ơn anh chị ạ

Bài đã được tự động gộp: 1/2/21

Anh cho em hỏi thêm một chút là nếu dùng VBA như trên mà em muốn hiện thị kết quả ở sheet khác thì chỉnh sửa cột thế nào ạ, mong anh hướng dẫn em ạ. Em cảm ơn anh

Thay code này vào code cũ

Sub Loc_Duy_Nhat()
Dim sArr(), Dic As Object, i As Long, j As Long, tmp As String
Set Dic = CreateObject("scripting.dictionary")
sArr = Sheets("Sheet1").[A1].CurrentRegion.Value
For i = 1 To UBound(sArr)
   For j = 1 To UBound(sArr, 2)
      tmp = UCase(sArr(i, j))
      Dic(tmp) = Empty
   Next
Next
With Sheets("Sheet2").[B15]
   .Resize(Dic.Count) = Application.Transpose(Dic.keys)
   .Resize(Dic.Count).Sort .Parent.[B14]
End With
MsgBox "Done", 64
End Sub

 

[Phamanh1998]

Thay code này vào code cũ

Sub Loc_Duy_Nhat()
Dim sArr(), Dic As Object, i As Long, j As Long, tmp As String
Set Dic = CreateObject("scripting.dictionary")
sArr = Sheets("Sheet1").[A1].CurrentRegion.Value
For i = 1 To UBound(sArr)
   For j = 1 To UBound(sArr, 2)
      tmp = UCase(sArr(i, j))
      Dic(tmp) = Empty
   Next
Next
With Sheets("Sheet2").[B15]
   .Resize(Dic.Count) = Application.Transpose(Dic.keys)
   .Resize(Dic.Count).Sort .Parent.[B14]
End With
MsgBox "Done", 64
End Sub

Em cảm ơn anh ạ.
Em mong anh chị nào đi qua nếu được xin cho em thêm phương án sử dụng hàm với ạ. Em cảm ơn anh chị

 

[befaint]

. . . . . Hàm

 

[Phamanh1998]

. . . . . Hàm

Em cảm ơn anh ạ. Anh cho em hỏi thêm một chút nữa được không ạ. Em vừa thử thêm ngày tháng vào và sửa công thức của anh để truy xuất dữ liệu theo khoảng thời gian thì kết quả không được như ý. Mong anh xem xét và giúp em để vấn đề của em được giải quyết ạ. Em cảm ơn anh ạ

 

[befaint]

cho em hỏi thêm một chút nữa được không

Không .

 

[phihndhsp]

Em cảm ơn anh ạ. Anh cho em hỏi thêm một chút nữa được không ạ. Em vừa thử thêm ngày tháng vào và sửa công thức của anh để truy xuất dữ liệu theo khoảng thời gian thì kết quả không được như ý. Mong anh xem xét và giúp em để vấn đề của em được giải quyết ạ. Em cảm ơn anh ạ

lượm code anh hải sửa lại cho bạn xem đúng không?
Sub Loc_Duy_Nhat()
Dim sArr(), Dic As Object, i As Long, j As Long, tmp As String
Dim tungay As Date, denngay As Date
tungay = Sheet1.Range("N1")
denngay = Sheet1.Range("P1")
Set Dic = CreateObject("scripting.dictionary")
sArr = Sheet1.Range("A1:H17")
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) >= tungay And sArr(i, 1) <= denngay Then
For j = 2 To UBound(sArr, 2)
tmp = UCase(sArr(i, j))
If Not Dic.exists(tmp) Then
Dic.Add tmp, ""
End If
Next
End If
Next
Sheet1.Range("M2:M1000").Clear
Sheet1.Range("M2").Resize(Dic.Count) = Application.Transpose(Dic.keys)

End Sub

 

[VetMini]

lượm code anh hải sửa lại cho bạn xem đúng không?
Sub Loc_Duy_Nhat()
Dim sArr(), Dic As Object, i As Long, j As Long, tmp As String
Dim tungay As Date, denngay As Date
tungay = Sheet1.Range("N1")
denngay = Sheet1.Range("P1")
Set Dic = CreateObject("scripting.dictionary")
sArr = Sheet1.Range("A1:H17")
For i = 1 To UBound(sArr, 1)
If sArr(i, 1) >= tungay And sArr(i, 1) <= denngay Then
For j = 2 To UBound(sArr, 2)
tmp = UCase(sArr(i, j))
If Not Dic.exists(tmp) Then
Dic.Add tmp, ""
End If
Next
End If
Next
Sheet1.Range("M2:M1000").Clear
Sheet1.Range("M2").Resize(Dic.Count) = Application.Transpose(Dic.keys)

End Sub

Code này làm việc không "trung thực". Dữ liệu của "keys" bị biến thành chữ hoa hết.
Làm như vầy tiện hơn, ít ra thì phần lớn dữ liệu còn giữ lại hoa/thường của chúng:

Dic.CompareMode = TextCompare ' key sẽ không phân biệt hoa/thường
Set Dic = CreateObject("scripting.dictionary")
...
For j = 2 To UBound(sArr, 2)
Dic(sArr(i, j)) = "" ' hoa/thường sẽ theo lần xuất hiện đầu tiên
Next

Hoặc là:

For j = 2 To UBound(sArr, 2)
Dic(UCase(sArr(i, j))) = sArr(i, j) ' hoa/thường sẽ theo lần xuất hiện cuối cùng
Next
...
Sheet1.Range("M2").Resize(Dic.Count) = Application.Transpose(Dic.items)