Cách loại bỏ những kí tự trùng nhau. (3 người xem)

[ndu96081631]

hic, bác sealand giúp em cho chót. Em muốn loại bỏ ký tự trùng nhau nhưng vẫn giữ lại khoảng trắng hoặc dấu phẩy
ab cd a --> d cd
1,2,3,2,5 --> 1,3,5
Thank bác

Làm được, nhưng bạn phải liệt kê ra cho mọi người biết những dấu nào bạn cho là dấu phân cách
Trong ví dụ trên thì dấu cách và phẩy là dấu phân cách ---> Trong file của bạn còn dấu nào được xem là dấu phân cách nữa không? (chẳng hạn là dấu -, dấu _, dấu &... vân vân..)

 

[zine]

Trong file của em gồm có dẩy (,) và khoảng trắng ( )
Không có những ký tự phân cách khác
Giả sử có, thì em có thể dùng Replace để thay các ký tự khác thànhdaayus , hoặc khoảng trắng ( ) được không nhỉ
Cảm ơn các bác
Em bổ sung thêm là hai ký tự liền nhau sẽ khác với ký tự tách riêng
Ví dụ
1 2 3 2 44 12 --> 1 3 44 12
12 1 2 3 1 2 --> 12 3

 

[sealand]

hic, bác sealand giúp em cho chót. Em muốn loại bỏ ký tự trùng nhau nhưng vẫn giữ lại khoảng trắng hoặc dấu phẩy
ab cd a --> d cd
1,2,3,2,5 --> 1,3,5
Thank bác

Đây là hàm mình cũng chưa làm thủ tục tinh chỉnh phần thân chuỗi:

Function loc2(ch As String) As String
Dim i, Kq, ch1
ch = Trim(ch)
For i = 1 To Len(ch)
ch1 = Mid(ch, i, 1)
If ch1 = "," Or ch1 = " " Then Kq = Kq & ch1
If Len(ch) - Len(Replace(ch, ch1, "")) = 1 Then Kq = Kq & ch1
Next
Do
Kq = Replace(Kq, "  ", " ")
Loop Until Len(Kq) = Len(Replace(Kq, "  ", " "))
Do
Kq = Replace(Kq, ",,", ",")
Loop Until Len(Kq) = Len(Replace(Kq, ",,", ","))
Kq = Trim(Kq)
If Left(Kq, 1) = "," Then Kq = Right(Kq, Len(Kq) - 1)
If Right(Kq, 1) = "," Then Kq = Left(Kq, Len(Kq) - 1)
loc2 = Kq
End Function

Tranh thủ viết xong giờ lại thấy đổi yêu cầu, mình sẽ làm lại sau vì giờ tan sở rồi.

 

[zine]

Bac sealand làm về lĩnh vực gì nhỉ, em làm kế toán.
Ko biết có quyển sách hay hướng dẫn gì để viết những add in đơn giản ko ? Em mù vấn đề này quá

 

[ndu96081631]

Đây là hàm mình cũng chưa làm thủ tục tinh chỉnh phần thân chuỗi:

Function loc2(ch As String) As String
Dim i, Kq, ch1
ch = Trim(ch)
For i = 1 To Len(ch)
ch1 = Mid(ch, i, 1)
If ch1 = "," Or ch1 = " " Then Kq = Kq & ch1
If Len(ch) - Len(Replace(ch, ch1, "")) = 1 Then Kq = Kq & ch1
Next
Do
Kq = Replace(Kq, "  ", " ")
Loop Until Len(Kq) = Len(Replace(Kq, "  ", " "))
Do
Kq = Replace(Kq, ",,", ",")
Loop Until Len(Kq) = Len(Replace(Kq, ",,", ","))
Kq = Trim(Kq)
If Left(Kq, 1) = "," Then Kq = Right(Kq, Len(Kq) - 1)
If Right(Kq, 1) = "," Then Kq = Left(Kq, Len(Kq) - 1)
loc2 = Kq
End Function

Tranh thủ viết xong giờ lại thấy đổi yêu cầu, mình sẽ làm lại sau vì giờ tan sở rồi.

Em thì làm vầy:

Function SingleChar(Text As String) As String
  Dim i As Long, iCount As Long, k As Long
  Dim TmpStr As String, Sep As String, Temp, Item, Arr()
  If InStr(Text, " ") Then Sep = " "
  If InStr(Text, ",") Then Sep = ","
  Temp = Split(Text, Sep)
  For Each Item In Temp
    TmpStr = CStr(Item)
    For i = 1 To Len(CStr(Item))
      iCount = Len(Text) - Len(Replace(Text, Mid(CStr(Item), i, 1), ""))
      If iCount > 1 Then TmpStr = Replace(TmpStr, Mid(CStr(Item), i, 1), "")
    Next i
    If TmpStr <> "" Then
      ReDim Preserve Arr(k)
      Arr(k) = TmpStr: k = k + 1
    End If
  Next Item
  SingleChar = Join(Arr, Sep)
End Function

Giảm bớt được 1 vòng lập
Nhưng em còn đang phân vân, không biết trên thực tế có tồn tại cùng 1 lúc 2 dấu phân cách trong 1 chuổi hay không? Nếu có thì... Ẹc.. Ẹc.. tính cũng hơi mệt

 

[zine]

Bác ndu96081631 à, nếu phân biệt ab a b là các ký tự khác nhau, tức là ab khác a, khác b (ab a b a -->ab b) được không ạ

 

[ndu96081631]

Bác ndu96081631 à, nếu phân biệt ab a b là các ký tự khác nhau, tức là ab khác a, khác b (ab a b a -->ab b) được không ạ

Cái gì cũng.. có thể làm được (miễn nó không vô lý)
Tôi đề nghị thế này:
- Bạn giả lập 1 file, trong đó cột A bạn liệt kê 1 số chuổi (khoảng 10 đến 20 dòng với nhiều trường hợp khác nhau)
- Cột B bạn ghi kết quả mà bạn muốn đạt được
- Gữi file lên đây!

 

[zine]

Em gửi file, của em có ba trường hợp. cảm ơn bác nodu. Em đang bắt chước để viết được các add in đơn giản

 

[ndu96081631]

Em gửi file, của em có ba trường hợp. cảm ơn bác nodu. Em đang bắt chước để viết được các add in đơn giản

Thấy đơn giản vậy mà cũng khó nhai ---> Vấn đề ở chổ làm sao COUNTIF các phần tử trong 1 Array (trong khi hàm COUNTIF chỉ làm với Range)
Thôi thì tạo 2 hàm vậy:

Function ArrayCountIf(SrcArray, CriteriaValue)
  Dim iCount As Long, Item
  For Each Item In SrcArray
    If Item = CriteriaValue Then iCount = iCount + 1
  Next
  ArrayCountIf = iCount
End Function

Function SingleChar(Text As String) As String
  Dim k As Long, Sep As String, Temp, Item, Arr()
  If InStr(Text, " ") Then Sep = " "
  If InStr(Text, ",") Then Sep = ","
  Temp = Split(Text, Sep)
  For Each Item In Temp
    If ArrayCountIf(Temp, Item) = 1 Then
      ReDim Preserve Arr(k)
      Arr(k) = Item: k = k + 1
    End If
  Next Item
  SingleChar = Join(Arr, Sep)
End Function

Công thức tại cell B3 là =SingleChar(A3)

 

[zine]

Em không tải được file đính kèm của bác, "Địa chỉ Tập Tin Ðính Kèm không đúng. Nếu địa chỉ này là chính xác, vui lòng gửi thư cho administrator"
Dùng hàm trên thì báo lỗ #name?
Bác up lại giúp em nhé.

 

[sealand]

Bac sealand làm về lĩnh vực gì nhỉ, em làm kế toán.
Ko biết có quyển sách hay hướng dẫn gì để viết những add in đơn giản ko ? Em mù vấn đề này quá

Cám ơn bạn đã quan tâm, mình cũng là dân Kế toán như bạn.
Sách chuyên về vấn đề bạn cần mình không có. Mình thấy, với yêu cầu các AddIn đơn giản thực hiện các yêu cầu công việc bình thường thì tham khảo diễn đàn cũng là 1 hướng tích cực. KHông có tài liệu nào biết bạn cần gì bằng trao đổi trực tiếp. Thậm chí kể cả hướng dẫn viết thư vịên .dll. Bạn vào thư viện hay tìm kiếm sẽ có cả. Chúc bạn sớm toại nguyện.

 

[ndu96081631]

Em không tải được file đính kèm của bác, "Địa chỉ Tập Tin Ðính Kèm không đúng. Nếu địa chỉ này là chính xác, vui lòng gửi thư cho administrator"
Dùng hàm trên thì báo lỗ #name?
Bác up lại giúp em nhé.

Up lại file xem thế nào nhé