Mình cần xin hàm tự tạo lọc duy nhất cho chuỗi có ký tự ngăn cách xác định

[ManhDuc1382]

Chào các bạn, mình đang cần xin hàm tự tạo LocChuoi để lọc duy nhất cho chuỗi có ký tự ngăn cách xác định, ví dụ chuỗi "ab,cd,ab,dc,cd,ge,h,f,p" chẳng hạn. Cấu trúc hàm như sau: =LocChuoi( Chuỗi , Dấu ngăn cách , Trường hợp không có dấu ngăn cách thì có lọc không (True , False)) . Nội dung chi tiết của hàm lọc chuỗi mình đã viết trong file đính kèm, cảm ơn các bạn đã giúp đỡ

 

[PacificPR]

Chào các bạn, mình đang cần xin hàm tự tạo LocChuoi để lọc duy nhất cho chuỗi có ký tự ngăn cách xác định, ví dụ chuỗi "ab,cd,ab,dc,cd,ge,h,f,p" chẳng hạn. Cấu trúc hàm như sau: =LocChuoi( Chuỗi , Dấu ngăn cách , Trường hợp không có dấu ngăn cách thì có lọc không (True , False)) . Nội dung chi tiết của hàm lọc chuỗi mình đã viết trong file đính kèm, cảm ơn các bạn đã giúp đỡ

Khiếp cứ abc và nmh chẳng biết đâu mà lần

Function Filter_String(ByVal Text As String, _
        Optional ByVal Delimiter As String, _
        Optional ByVal Choice As Boolean) As String
    Dim Dic As Object, aTmp, I As Long
If Len(Text) = 0 Then Exit Function
Set Dic = CreateObject("Scripting.Dictionary")
If IsMissing(Choice) Then Choice = True
If Delimiter = "" Then
    If Choice = False Then
        Filter_String = Text: Exit Function
    Else
         For I = 1 To Len(Text)
            If Not Dic.Exists(Mid(Text, I, 1)) Then Dic.Add Mid(Text, I, 1), ""
        Next I
    End If
Else
    For Each aTmp In Split(Text, Delimiter)
        If Not Dic.Exists(aTmp) Then Dic.Add aTmp, ""
    Next
End If
If Dic.Count Then Filter_String = Join(Dic.Keys, Delimiter)
End Function

 

[ndu96081631]

Chào các bạn, mình đang cần xin hàm tự tạo LocChuoi để lọc duy nhất cho chuỗi có ký tự ngăn cách xác định, ví dụ chuỗi "ab,cd,ab,dc,cd,ge,h,f,p" chẳng hạn. Cấu trúc hàm như sau: =LocChuoi( Chuỗi , Dấu ngăn cách , Trường hợp không có dấu ngăn cách thì có lọc không (True , False)) . Nội dung chi tiết của hàm lọc chuỗi mình đã viết trong file đính kèm, cảm ơn các bạn đã giúp đỡ

Hồi lâu lắm rồi có viết cái này:

Function StrUnique(ByVal Text As String, Optional ByVal Delimiter As String = vbNullString) As String
  Dim idx As Long
  Dim key As String
  Dim aTemp
  On Error Resume Next
  If Len(Text) = 0 Then Exit Function
  If Delimiter = vbNullString Then
    StrUnique = Left(Text, 1)
    For idx = 1 To Len(Text)
      key = Mid(Text, idx, 1)
      If InStr(StrUnique, key) = 0 Then StrUnique = StrUnique & key
    Next
  Else
    aTemp = Split(Text, Delimiter)
    With CreateObject("Scripting.Dictionary")
      For idx = 0 To UBound(aTemp)
        key = Trim(aTemp(idx))
        If Len(key) Then .Add key, Empty
      Next
      StrUnique = Join(.Keys, Delimiter)
    End With
  End If
End Function

Thấy bạn có đề cập "=LocChuoi( Chuỗi , Dấu ngăn cách , Trường hợp không có dấu ngăn cách thì có lọc không (True , False)) " <---- Không lọc thì để yên đó chứ viết hàm làm gì

 

[ManhDuc1382]

Hồi lâu lắm rồi có viết cái này:

Function StrUnique(ByVal Text As String, Optional ByVal Delimiter As String = vbNullString) As String
  Dim idx As Long
  Dim key As String
  Dim aTemp
  On Error Resume Next
  If Len(Text) = 0 Then Exit Function
  If Delimiter = vbNullString Then
    StrUnique = Left(Text, 1)
    For idx = 1 To Len(Text)
      key = Mid(Text, idx, 1)
      If InStr(StrUnique, key) = 0 Then StrUnique = StrUnique & key
    Next
  Else
    aTemp = Split(Text, Delimiter)
    With CreateObject("Scripting.Dictionary")
      For idx = 0 To UBound(aTemp)
        key = Trim(aTemp(idx))
        If Len(key) Then .Add key, Empty
      Next
      StrUnique = Join(.Keys, Delimiter)
    End With
  End If
End Function

Thấy bạn có đề cập "=LocChuoi( Chuỗi , Dấu ngăn cách , Trường hợp không có dấu ngăn cách thì có lọc không (True , False)) " <---- Không lọc thì để yên đó chứ viết hàm làm gì

vâng ạ, tại lúc đó em thấy chỗ ấy có vẻ có lý nên em viết thêm ạ rất cảm ơn anh vì đã chia sẻ code của hàm quan trọng này ạ, chứ thường thì em dùng cách khác mà xử lý tầm 60 nghìn dòng trở lên thì lâu lắm

 

[VetMini]

Sáu chục ngàn chuỗi. Cứ lọc mỗi chuỗi lại phải dựng cái đít lên và lọc xong thì xoá nó đi ?!?
Cuối cùng thì chỉ một cái đít dựng lên và xoá đi sáu chục ngàn lần.

Tuy trên thực tế Windows cũng không đến nổi ngu. Cái đít dựng lên còn nằm tỏng bộ nhớ, nó chỉ việc nối lại. Nhưng theo nguyên tắc lập trình thì đây là chuyện phí phạm.

Thuật toán loại đề bài này phải tuỳ theo dữ liệu.
Nếu chuỗi chỉ có chừng chục phần thì xài đít là phí phạm.
Nếu chuỗi có chừng vài chục phần thì đít bắt đầu có hiệu quả.
Lọc chuỗi theo kiểu từng ký tự mà phải dùng hàm & liên tục là cách chỉ nên làm cho chuỗi ngắn. Khi chuỗi dài thì cách làm hiệu quả chỉ dùng 1 buffer để chứa chuỗi, và dọn nó lại sau khi đã xong.

 

[ManhDuc1382]

Khiếp cứ abc và nmh chẳng biết đâu mà lần

Function Filter_String(ByVal Text As String, _
        Optional ByVal Delimiter As String, _
        Optional ByVal Choice As Boolean) As String
    Dim Dic As Object, aTmp, I As Long
If Len(Text) = 0 Then Exit Function
Set Dic = CreateObject("Scripting.Dictionary")
If IsMissing(Choice) Then Choice = True
If Delimiter = "" Then
    If Choice = False Then
        Filter_String = Text: Exit Function
    Else
         For I = 1 To Len(Text)
            If Not Dic.Exists(Mid(Text, I, 1)) Then Dic.Add Mid(Text, I, 1), ""
        Next I
    End If
Else
    For Each aTmp In Split(Text, Delimiter)
        If Not Dic.Exists(aTmp) Then Dic.Add aTmp, ""
    Next
End If
If Dic.Count Then Filter_String = Join(Dic.Keys, Delimiter)
End Function

Mình cảm ơn bạn nhiều nhé

 

[PacificPR]

Mình cảm ơn bạn nhiều nhé

"Dận dồi" . Không chơi nữa

 

[VetMini]

Khiếp cứ abc và nmh chẳng biết đâu mà lần

Function Filter_String(ByVal Text As String, _
        Optional ByVal Delimiter As String, _
        Optional ByVal Choice As Boolean) As String
    Dim Dic As Object, aTmp, I As Long
If Len(Text) = 0 Then Exit Function
Set Dic = CreateObject("Scripting.Dictionary")
If IsMissing(Choice) Then Choice = True
If Delimiter = "" Then
    If Choice = False Then
        Filter_String = Text: Exit Function
    Else
         For I = 1 To Len(Text)
            If Not Dic.Exists(Mid(Text, I, 1)) Then Dic.Add Mid(Text, I, 1), ""
        Next I
    End If
Else
    For Each aTmp In Split(Text, Delimiter)
        If Not Dic.Exists(aTmp) Then Dic.Add aTmp, ""
    Next
End If
If Dic.Count Then Filter_String = Join(Dic.Keys, Delimiter)
End Function

Hai cách làm, hai công việc riêng biệt nhau thì đáng lẽ phải chia làm 2 hàm:
If Delimiter = "" Then
If Choice Then Filter_String = FilterChars(Text) Else Filter_String = Text
Else
Filter_String = FilterWDelim(Text, Delim)
End If

Fucntion FilterChars(Text As String) As String
' hàm lọc chuỗi ký tự Text, trả về chuỗi có mỗi ký tự là duy nhất, lượt bỏ những ký tự lặp lại.
' giải thuật: hàm dùng 1 buffer chính để dồn những ký tự được chọn
' hàm dùng mảng để lọc ký tự
' cỡ dưới vài chục ngàn số thì mảng hiệu quả hơn dictionary
Dim chrSet(0 To 33000) As Boolean ' nếu không phải unicode thì khoảng 260 đủ rồi
Dim i As Integer, i2 As Integer, c As String
For i = 1 To Len(Text)
c = Mid(Text, i, 1)
If Not chrSet(AscW(c)) Then ' thay bằng Asc(c) nếu không phải Unicode
i2 = i2 + 1
Mid(Text, i2, 1) = c
chrSet(AscW(c)) = True
End If
Next i
FilterChars = Left(Text, i2)
End Function

Function FilterWDelim(Text As String, Delim As String) As String
' hàm lọc chuỗi ký tự với những cụm từ ngăn cách bởi Delim
' hàm trả về các cụm từ duy nhất, lượt bỏ những cụm từ lặp lại
' nếu sử dụng dic thì chỉ dựng 1 lần, và giữ đấy để làm tiếp lần khác
Static Dic As Object
If Dic Is Nothing Then
Set Dic = CreateObject("Scripting.Dicionary")
Else
Dic.RemoveAll
End If
... ' code ở đây
End Function