Danh Mục duy nhất (sắp xêp), Lấy từ bất kỳ trong câu! (1 người xem)

[nguyentuhp]

Vâng, đã có rất nhiều người đã lập các hàm (bằng công thức, bằng code) để tìm danh mục duy nhất trong một cột dữ liệu. Hàm lấy tên tuổi (Lấy họ, tên đệm, Tên, ..) hoặc lấy một từ nào đó trong câu.
Qua sử dụng tôi thấy các hàm đó sử dụng chưa được tiện dụng vì:
- Sử dụng các hàm sẵn có trong excel thì hàm quá dài.
- Sử dụng code để lập hàm: cần ít nhất 2 lần nhập liệu cho 1 lần thực hiện (dòng đầu tiên, dòng thứ 2 rồi mới Fill được công thức) hoặc sử dụng công thức mảng thì cảm giác hơi khó chịu vì không xóa các dòng báo lỗi (dòng thừa ngoài vùng tham chiếu) hoặc phải dùng đến vùng tham chiếu chính là kết quả của các lần thực hiện trước nên cảm giác rắc rối.
- Hàm lấy họ, tên đệm, tên nói riêng và lấy 1 từ bất kỳ nào trong câu dài chưa được mở rộng, chưa có nhiều lựa chọn và nếu dùng công thức của Excel thì quá dài.

Tôi xin giới thiệu 3 hàm:

TextO(): Tạo danh mục duy nhất từ 1 cột dữ liệu nào đó có nhiều dữ liệu giống nhau, bao gồm cả các cell empty.

TextOS() Tạo danh mục duy nhất từ 1 cột dữ liệu nào đó có nhiều dữ liệu giống nhau, bao gồm cả các cell empty và dữ liệu đã được sắp xếp

eText(): Lấy một từ bất kỳ trong câu, có nhiều tham số lựa chọn kèm theo

Mời các bác Download.
“Nổ tý tẹo ”

 

[Mr Okebab]

Vâng, đã có rất nhiều người đã lập các hàm (bằng công thức, bằng code) để tìm danh mục duy nhất trong một cột dữ liệu. Hàm lấy tên tuổi (Lấy họ, tên đệm, Tên, ..) hoặc lấy một từ nào đó trong câu.
Qua sử dụng tôi thấy các hàm đó sử dụng chưa được tiện dụng vì:
- Sử dụng các hàm sẵn có trong excel thì hàm quá dài.
- Sử dụng code để lập hàm: cần ít nhất 2 lần nhập liệu cho 1 lần thực hiện (dòng đầu tiên, dòng thứ 2 rồi mới Fill được công thức) hoặc sử dụng công thức mảng thì cảm giác hơi khó chịu vì không xóa các dòng báo lỗi (dòng thừa ngoài vùng tham chiếu) hoặc phải dùng đến vùng tham chiếu chính là kết quả của các lần thực hiện trước nên cảm giác rắc rối.
- Hàm lấy họ, tên đệm, tên nói riêng và lấy 1 từ bất kỳ nào trong câu dài chưa được mở rộng, chưa có nhiều lựa chọn và nếu dùng công thức của Excel thì quá dài.

Tôi xin giới thiệu 3 hàm:

TextO(): Tạo danh mục duy nhất từ 1 cột dữ liệu nào đó có nhiều dữ liệu giống nhau, bao gồm cả các cell empty.

TextOS() Tạo danh mục duy nhất từ 1 cột dữ liệu nào đó có nhiều dữ liệu giống nhau, bao gồm cả các cell empty và dữ liệu đã được sắp xếp

eText(): Lấy một từ bất kỳ trong câu, có nhiều tham số lựa chọn kèm theo

Mời các bác Download ví dụ và AddIn kèm theo.
“Nổ tý tẹo ”

Rất cảm ơn những đóng góp của bạn!

Mình chưa xem hết File của bạn, chỉ góp ý thế này:

Chỉ vì muốn xem công trình của bạn mà lại phải cài thêm 1 Addins nữa thì e . . không đáng.

Sao bạn không cho code của bạn vào trong File luôn, như vậy dễ kiểm tra hơn nhiều, và nếu có thể thì post code của bạn lên diễn đàn luôn.

Chứ như thế này và để kiểm tra File của bạn thì . . mất công quá.

Thân!

 

[nguyentuhp]

Vâng, trước tiên xin cảm ơn góp ý của các bác!
Tùy theo quan niệm của mỗi người làm như thế nào là tiện lợi, theo quan niệm của bác thì một số người chưa biết về VBA, sau khi kiểm tra họ muốn sử dụng các hàm này cho tất cả các file của họ thì sao ạ?

Chỉ vì muốn xem công trình của bạn mà lại phải cài thêm 1 Addins nữa thì e . . không đáng.

Chứ như thế này và để kiểm tra File của bạn thì . . mất công quá.

vâng, tùy theo nhu cầu của mỗi người nếu kiểm tra thấy OK thì họ giữ lại, nếu không muốn thì họ remove đi. Việc Add và remove Addin đối với bác tôi nghĩ thời gian không quá 3 giây đâu ạ.

Lưu ý: Hàm LISTOS() do phải sắp xếp lại nên rất chậm đối với vài trăm dữ liệu
Cách tốt nhất là làm xong copy và dán lại giá trị hoặc các bác chuyển sang Sub() chạy cho ngon.

Chúc các bác thành công!

 

[levanduyet]

Về vấn đề này tôi thấy có nhiều cách.
Và cách dùng Dictionary Object này cũng hay, tôi xin giới thiệu với các bạn.

Sub FilterUniqueNumbers3() 
   Dim vValue As Variant, vVals As Variant 
   Dim myRange As Range 
   Dim i As Long 
   Dim dArr() As Double 
   Dim oDic As Object 
   Set myRange = Worksheets(1).Range("A1:A10") 
   'The Dictionary object is always present in Windows so it can always be created
   Set oDic = CreateObject("scripting.dictionary") 
   oDic.comparemode = vbTextCompare 
   'Read the values from a range into vVals
   vVals = myRange.Value 
   'ReDim dArr and make it two dimensional by adding the second argument 1 To 1
   'otherwise you can't dump it in a worksheet later.
   ReDim dArr(UBound(vVals) - 1, 1 To 1) 
   For Each vValue In vVals 
      'Note the use of the Dictionary object to exclude double values
      If Not IsEmpty(vValue) And Not oDic.exists(vValue) Then 
         dArr(i, 1) = vValue 
         oDic.Add vValue, Nothing 
         i = i + 1 
      End If 
   Next vValue 
   'Free memory by removing the Dictionary object and vVals from memory
   Set oDic = Nothing 
   Erase vVals 
   'Remove old data
   myRange.Clear 
   'Dump dArr values in worksheet
   myRange.Resize(i).Value = dArr 
End Sub

http://my.opera.com/levanduyet/blog/lay

Ngoài ra còn có thể áp dụng cái add-in A-Tools

Lê Văn Duyệt

 

[damLuat]

Đoạn code Sub FilterUniqueNumbers3()tôi đã chạy thử và muốn ứng dụng nó, nhưng Kết quả trả về tôi muốn thể hiện ở Sheet2 để dữ liệu nguồn ở sheet1 không bị xoá. Mong được bạn bổ sung, vì tôi chưa biết nhiều về lập trình.
Thành viên mới: Đàm Luật Hộp thư: dvluat@gmail.com. Rất mong sự chia sẻ của bạn.

 

[levanduyet]

Bạn có thể sửa lại như sau:

Sub FilterUniqueNumbers3()
   Dim vValue As Variant, vVals As Variant
   Dim myRange As Range, TargetRange As Range
   Dim i As Long
   Dim dArr() As Variant 'As Double
   Dim oDic As Object
   Set myRange = Worksheets("Sheet1").Range("A1:A10")
   'The Dictionary object is always present in Windows so it can always be created
   Set oDic = CreateObject("scripting.dictionary")
   oDic.comparemode = vbTextCompare
   'Read the values from a range into vVals
   vVals = myRange.Value
   'ReDim dArr and make it two dimensional by adding the second argument 1 To 1
   'otherwise you can't dump it in a worksheet later.
   ReDim dArr(UBound(vVals) - 1, 1 To 1)
   For Each vValue In vVals
      'Note the use of the Dictionary object to exclude double values
      If Not IsEmpty(vValue) And Not oDic.exists(vValue) Then
         dArr(i, 1) = vValue
         oDic.Add vValue, Nothing
         i = i + 1
      End If
   Next vValue
   'Free memory by removing the Dictionary object and vVals from memory
   Set oDic = Nothing
   Erase vVals
   'Target Range
   Set TargetRange = Worksheets("Sheet2").Range("A1")
   TargetRange.Resize(i).Value = dArr
   Set TargetRange = Nothing
End Sub

Giải thích:
Vùng bạn cần copy là A1:A10 của Sheet1

Set myRange = Worksheets("Sheet1").Range("A1:A10")

Vùng bạn cần đưa thông tin ra là:
Vùng A1 của Sheet2

Set TargetRange = Worksheets("Sheet2").Range("A1")

Lê Văn Duyệt

 

[quyenpv]

Anh Duyệt ơi, anh có thể cải tiến hàm của anh thành hàm động có được không anh. Ý em anh phát triển thêm lấy nguồn lọc bất kỳ, và vị trí hiện kết quả có được không anh

 

[quyenpv]

Bạn có thể sửa lại như sau:

Sub FilterUniqueNumbers3()
   Dim vValue As Variant, vVals As Variant
   Dim myRange As Range, TargetRange As Range
   Dim i As Long
   Dim dArr() As Variant 'As Double
   Dim oDic As Object
   Set myRange = Worksheets("Sheet1").Range("A1:A10")
   'The Dictionary object is always present in Windows so it can always be created
   Set oDic = CreateObject("scripting.dictionary")
   oDic.comparemode = vbTextCompare
   'Read the values from a range into vVals
   vVals = myRange.Value
   'ReDim dArr and make it two dimensional by adding the second argument 1 To 1
   'otherwise you can't dump it in a worksheet later.
   ReDim dArr(UBound(vVals) - 1, 1 To 1)
   For Each vValue In vVals
      'Note the use of the Dictionary object to exclude double values
      If Not IsEmpty(vValue) And Not oDic.exists(vValue) Then
         dArr(i, 1) = vValue
         oDic.Add vValue, Nothing
         i = i + 1
      End If
   Next vValue
   'Free memory by removing the Dictionary object and vVals from memory
   Set oDic = Nothing
   Erase vVals
   'Target Range
   Set TargetRange = Worksheets("Sheet2").Range("A1")
   TargetRange.Resize(i).Value = dArr
   Set TargetRange = Nothing
End Sub

Giải thích:
Vùng bạn cần copy là A1:A10 của Sheet1

Set myRange = Worksheets("Sheet1").Range("A1:A10")

Vùng bạn cần đưa thông tin ra là:
Vùng A1 của Sheet2

Set TargetRange = Worksheets("Sheet2").Range("A1")

Lê Văn Duyệt

Các anh sửa giúp em 2 vùng kia thành 2 biến cho phép mình tùy chỉnh được ko anh