Các phương pháp tách số từ chuỗi và ngược lại, đề nghị post tại đây (5 người xem)

[HeSanbi]

Tại mình mới dùng VBA. Bạn có thể ghi giúp mình không ạ.
Mình mới chỉ tách được tên. Nhưng những tên trùng thì nó không hiện ra được số (

Bạn có thể thử hàm dưới đây:

Hàm có sử dụng từ khóa để định hình khối dữ liệu phân tích, để giúp bạn sử dụng được nhiều nơi nhiều lần
Hàm có tham số format để dễ dàng định dạng tên trùng
=ShortName("A B C")

Function ShortName(ByVal FullName As String, Optional format As String = "0#", Optional key As String = "C") As String
  On Error Resume Next
  Dim i As Byte, v$, r As Range, D0
  Static D As Object
  If key = "" Then
    Set r = Application.Caller
    If TypeName(r) = "Range" Then
      key = r.EntireColumn.Address(0, 0, external:=1)
    Else
      key = ActiveCell.EntireColumn.Address(0, 0, external:=1)
    End If
  End If

  If Not D Is Nothing Then
    If IsNumeric(FullName) Then Set D = Nothing
  End If
 
  If D Is Nothing Then
    Set D = VBA.CreateObject("Scripting.Dictionary"): D.CompareMode = 1
  End If
  If Not D.exists(key) Then
    Set D0 = VBA.CreateObject("Scripting.Dictionary"): D0.CompareMode = 1
    D.Add key, D0
  Else
    Set D0 = D(key)
  End If

  FullName = Trim(FullName): v = Left(FullName, 1)
  For i = 1 To Len(FullName) - 1
    If Mid(FullName, i, 2) Like " [! ]" Then v = v + Mid(FullName, i + 1, 1)
  Next
  If D0.exists(v) Then
    i = D0(v): D0.Remove v: D0.Add v, i + 1
    v = v & VBA.format(i, format)
  Else
    D0.Add v, 0
  End If
  ShortName = v
End Function

 

[meoconduaxe]

Function xử lý từng ô thì không cần dùng dic, cần thêm tham số các mã được tạo trước đó

Function Name(str As String, rng As Range) As String
  If str = Empty Then Exit Function
  Dim i As Long, k As Long, tmp As String, cel As Range
  str = Trim(str): tmp = Left(str, 1)
  For i = 1 To Len(str)
    If Mid(str, i, 1) = " " Then tmp = tmp + Mid(str, i + 1, 1)
  Next
  For Each cel In rng
    If cel.Value = tmp Then
      k = k + 1
    ElseIf cel.Value Like tmp & "##" Then
      k = k + 1
    End If
  Next cel
  If k = 0 Then
    Name = tmp
  Else
    Name = tmp & Format(k, "00")
  End If
End Function

thanks bạn đã chia sẻ nhé.

Bài đã được tự động gộp: 12/5/22

Function xử lý từng ô thì không cần dùng dic, cần thêm tham số các mã được tạo trước đó

Function Name(str As String, rng As Range) As String
  If str = Empty Then Exit Function
  Dim i As Long, k As Long, tmp As String, cel As Range
  str = Trim(str): tmp = Left(str, 1)
  For i = 1 To Len(str)
    If Mid(str, i, 1) = " " Then tmp = tmp + Mid(str, i + 1, 1)
  Next
  For Each cel In rng
    If cel.Value = tmp Then
      k = k + 1
    ElseIf cel.Value Like tmp & "##" Then
      k = k + 1
    End If
  Next cel
  If k = 0 Then
    Name = tmp
  Else
    Name = tmp & Format(k, "00")
  End If
End Function

thanks bạn nhé

 

[meoconduaxe]

Function xử lý từng ô thì không cần dùng dic, cần thêm tham số các mã được tạo trước đó

Function Name(str As String, rng As Range) As String
  If str = Empty Then Exit Function
  Dim i As Long, k As Long, tmp As String, cel As Range
  str = Trim(str): tmp = Left(str, 1)
  For i = 1 To Len(str)
    If Mid(str, i, 1) = " " Then tmp = tmp + Mid(str, i + 1, 1)
  Next
  For Each cel In rng
    If cel.Value = tmp Then
      k = k + 1
    ElseIf cel.Value Like tmp & "##" Then
      k = k + 1
    End If
  Next cel
  If k = 0 Then
    Name = tmp
  Else
    Name = tmp & Format(k, "00")
  End If
End Function

cho mình hỏi tí . Nếu trường hợp số thự tự lên trên 99 thì có lệnh gì chỉnh thêm vào được không bạn. Mình đang chỉnh trong file code kia mà chưa được. Thanks bạn---> Thôi mình làm được rồi

 

[Gacoi.px]

Có anh chị nào viết được hàm cho nội dung này hộ em không; em loay hoay mãi không biết làm thế nào

 

[Hoàng Tuấn 868]

Có anh chị nào viết được hàm cho nội dung này hộ em không; em loay hoay mãi không biết làm thế nào

Cái này để làm gì vậy bạn.

 

[BuiQuangThuan]

Cái này để làm gì vậy bạn.

Hihi. Bạn ấy thả vào nhiều topic thật ấy

 

[Hoàng Tuấn 868]

Hihi. Bạn ấy thả vào nhiều topic thật ấy

Mình hỏi rồi sang chỗ khác mới lại thấy tiếp.

 

[Hoàng Tuấn 868]

Hihi. Bạn ấy thả vào nhiều topic thật ấy

Mà hỏi không thấy trả lời thì ai muốn giúp nữa nhỉ. Thế này thì mình chắc chắn không rồi.

 

[nghiank09]

Chào mọi người,
Nhờ mọi người giúp mình tách các ký tự khoảng trắng, dấu chấm, dấu gạch ngang..., trong chuỗi số điện thoại (trong file đính kèm). Chuỗi này tách từ file HTML ạ.
VD:
0999.888.777 ->0999888777
0999 888 777 -> 0999888777
0999-888-777 -> 0999888777
Chuỗi số điện thoại xuất hiện ở 3 vị trí
<div> SĐT:<a href="tel: 0969.999.999">0969.999.999</a> - <a href="h t t p s ://zalo .me/0969.999.999">
Đôi khi có ký tự khoảng trắng xuất hiện trước SDT trong chuỗi h t t p s ://zalo .me/........ gây lỗi.
Cám ơn mọi người rất nhiều. Chúc mọi người một ngày tốt lành

 

[HUONGHCKT]

Chào mọi người,
Nhờ mọi người giúp mình tách các ký tự khoảng trắng, dấu chấm, dấu gạch ngang..., trong chuỗi số điện thoại (trong file đính kèm). Chuỗi này tách từ file HTML ạ.
VD:
0999.888.777 ->0999888777
0999 888 777 -> 0999888777
0999-888-777 -> 0999888777
Chuỗi số điện thoại xuất hiện ở 3 vị trí
<div> SĐT:<a href="tel: 0969.999.999">0969.999.999</a> - <a href="h t t p s ://zalo .me/0969.999.999">
Đôi khi có ký tự khoảng trắng xuất hiện trước SDT trong chuỗi h t t p s ://zalo .me/........ gây lỗi.
Cám ơn mọi người rất nhiều. Chúc mọi người một ngày tốt lành

Bạn thử nghiên cứu hàm UDF của anh Ndu xem sao.

Function ExtractChar(text As Variant, iType As String)
  Dim tmp 'As String
  tmp = Switch(iType = "L", "[^a-zA-Z]", iType = "N", "[^0-9]", iType = "S", "[0-9a-zA-Z]")
  With CreateObject("VBScript.RegExp")
    .Global = True: .Pattern = tmp
    ExtractChar = .Replace(text, "")
  End With
End Function

Sub Tach()
Dim i&, s, tmp
s = Split(Sheet1.Range("A1"), " ")
For i = 0 To UBound(s)
tmp = s(i)
    Sheet1.Cells(3, i + 2) = ExtractChar(tmp, "N")
Next i
End Sub