Mọi người giúp mình nhét 1 ký tự vào 1 chuỗi để cho nó dãn ra

[hunglam123]

Em chào các anh chị. Vừa rồi em có hỏi bài đọc Âm Thanh từ số của Thầy Batman1 . code đọc rất hay. nhưng có điều nó đọc hơi nhanh, khiến người ta nghe không kịp. em đã thử thêm dấu cách vào giửa các con số thì nó đọc từng số rõ ràng.
Nên nhờ mọi người giúp mình thêm 1 ký tự nào đó vào xen kẽ giữa chuổi thì phải làm sao. em cảm ơn ạ

em xin mô phỏng qua hình ảnh cho mọi người hiểu ạ . Ví dụ em muốn làm cho Vùng B3:B6 sang vùng C3:C6
Mình cần Sub để gán vào nút bấm chứ không cần Function do file mình hơn 5000 dòng ( tương ứng 5000 mã số bệnh nhân cách ly )

 

[excel_lv1.5]

Em chào các anh chị. Vừa rồi em có hỏi bài đọc Âm Thanh từ số của Thầy Batman1 . code đọc rất hay. nhưng có điều nó đọc hơi nhanh, khiến người ta nghe không kịp. em đã thử thêm dấu cách vào giửa các con số thì nó đọc từng số rõ ràng.
Nên nhờ mọi người giúp mình thêm 1 ký tự nào đó vào xen kẽ giữa chuổi thì phải làm sao. em cảm ơn ạ

em xin mô phỏng qua hình ảnh cho mọi người hiểu ạ . Ví dụ em muốn làm cho Vùng B3:B6 sang vùng C3:C6

View attachment 234661

Có vẻ bạn thích code, cho bạn cây búa này:

Function tach(ByVal str As String)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "(.)"
    tach = Trim(.Replace(str, "$1 "))
End With
End Function

 

[huonglien1901]

Em chào các anh chị. Vừa rồi em có hỏi bài đọc Âm Thanh từ số của Thầy Batman1 . code đọc rất hay. nhưng có điều nó đọc hơi nhanh, khiến người ta nghe không kịp. em đã thử thêm dấu cách vào giửa các con số thì nó đọc từng số rõ ràng.
Nên nhờ mọi người giúp mình thêm 1 ký tự nào đó vào xen kẽ giữa chuổi thì phải làm sao. em cảm ơn ạ

em xin mô phỏng qua hình ảnh cho mọi người hiểu ạ . Ví dụ em muốn làm cho Vùng B3:B6 sang vùng C3:C6

View attachment 234661

bạn thử!

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function

bạn thử công thức dưới đây!

=IF(LEN(B3)=1,"",SUBSTITUTE(JoinText(",",IF(LEN(B3)>1,MID(B3,ROW(INDIRECT("1:"&LEN(B3))),1),1/0)),","," "))

Nhấn ctrl+shift+enter!

 

[hunglam123]

Có vẻ bạn thích code, cho bạn cây búa này:

Function tach(ByVal str As String)
With CreateObject("vbscript.regexp")
    .Global = True
    .Pattern = "(.)"
    tach = Trim(.Replace(str, "$1 "))
End With
End Function

Tuyệt vời anh ơi cảm ơn anh rất nhiều. nhưng anh có thể Giúp em viết sub luôn đi anh ơi. để em gán vào nút bấm bấm 1 phát là ra luôn . Chứ file em hơn 5000 dòng em dùng cái này làm công thức trên bảng tính em thấy nó chậm quá anh

Bài đã được tự động gộp: 3/4/20

bạn thử!

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function

bạn thử công thức dưới đây!

=IF(LEN(B3)=1,B3,SUBSTITUTE(JoinText(",",IF(LEN(B3)>1,MID(B3,ROW(INDIRECT("1:"&LEN(B3))),1),1/0)),","," "))

Nhấn ctrl+shift+enter!

em cảm ơn anh ạ. Anh có thể viết Sub để em gán vào nút bấm được không. chứ cái này làm công thức 5000 dòng nó hơi chậm

 

[excel_lv1.5]

Tuyệt vời anh ơi cảm ơn anh rất nhiều. nhưng anh có thể Giúp em viết sub luôn đi anh ơi. để em gán vào nút bấm bấm 1 phát là ra luôn . Chứ file em hơn 5000 dòng em dùng cái này làm công thức trên bảng tính em thấy nó chậm quá anh

Bài đã được tự động gộp: 3/4/20

em cảm ơn anh ạ. Anh có thể viết Sub để em gán vào nút bấm được không. chứ cái này làm công thức 5000 dòng nó hơi chậm

Tại tôi không thích dùng vòng lặp, bạn chạy lại code này:

Function tach(ByVal str As String) As String
For i = 1 To Len(str)
    tach = tach & " " & Mid(str, i, 1)
Next
End Function
Sub a()
Dim arr, i As Long: arr = Range("b3:b" & Cells(Rows.Count, "b").End(xlUp).Row)
For i = 1 To UBound(arr)
    arr(i, 1) = Trim(tach(arr(i, 1)))
Next
[c3].Resize(UBound(arr), 1) = arr
End Sub

Bài đã được tự động gộp: 3/4/20

bạn thử!

Function JoinText(ByVal Delimiter As String, ParamArray Arrays()) As String
  Dim aTmp, arrDes(), Item, tmp As String
  Dim idx As Long, n As Long
  'On Error Resume Next
  For idx = LBound(Arrays) To UBound(Arrays)
    aTmp = Arrays(idx)
    If Not IsArray(aTmp) Then aTmp = Array(aTmp)
    For Each Item In aTmp
      If TypeName(Item) <> "Error" Then
        tmp = CStr(Item)
        n = n + 1
        ReDim Preserve arrDes(1 To n)
        arrDes(n) = tmp
      End If
    Next
  Next
  If n Then JoinText = Join(arrDes, Delimiter)
End Function

bạn thử công thức dưới đây!

=IF(LEN(B3)=1,"",SUBSTITUTE(JoinText(",",IF(LEN(B3)>1,MID(B3,ROW(INDIRECT("1:"&LEN(B3))),1),1/0)),","," "))

Nhấn ctrl+shift+enter!

Không cần phải xét điều kiện len()=1 , dùng trim cắt là được bạn ạ.

 

[VetMini]

Function NhetDauCach(s as string) as string
' nhét dấu cách vào giữa các ký tự trong string s
Dim i as integer
NhetDauCach = Space(Len(s)*2-1)
For i = 1 To Len(s)
Mid(NhetDauCach, i*2-1, 1) = Mid(s,i,1)
Next i
End Function

 

[HeSanbi]

Đoạn code chèn rất đơn giản không cần khởi tạo một thư viện nào cả:

Function InsertText(ByVal str As String,Optional Byval Text As String = " ") As String
    InsertText=Trim( Replace(StrConv(str, vbUnicode), vbNullChar ,Text))
End Sub

----------------------------------------------
Nếu có liên quan đến bài đọc tiếng Việt.
Vì sao không nhờ bác @batman1 thêm speed cho đoạn code

Có 2 cách thêm:

Sử dụng speed của thư viện MCI:
set music speed 700
tuy nhiên sẽ bị lạc giọng.

Hoặc nhờ bác batman1 sử dụng Argument ttsspeed=0.14 để giảm tốc độ đọc không bị lạc giọng đọc:
http://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&ttsspeed=0.14&q=Xin mời quý khách mang số 0 1 2 3 Vui lòng đến quầy

 

[hunglam123]

Function NhetDauCach(s as string) as string
' nhét dấu cách vào giữa các ký tự trong string s
Dim i as integer
NhetDauCach = Space(Len(s)*2-1)
For i = 1 To Len(s)
Mid(NhetDauCach, i*2-1, 1) = Mid(s,i,1)
Next i
End Function

code của anh chạy ok. Nhưng cho hỏi nếu sau này em thấy cách bằng 1 ký tự khác thì em sữa chỗ nào. thí dụ em thay bằng dấu * thì sữa ở đâu

Bài đã được tự động gộp: 3/4/20

Đoạn code chèn rất đơn giản không cần khởi tạo một thư viện nào cả:

Function InsertText(ByVal str As String,Optional Byval Text As String = " ") As String
    InsertText=Trim( Replace(StrConv(str, vbUnicode), vbNullChar ,Text))
End Sub

----------------------------------------------
Nếu có liên quan đến bài đọc tiếng Việt.
Vì sao không nhờ bác @batman1 thêm speed cho đoạn code

Có 2 cách thêm:

Sử dụng speed của thư viện MCI:
set music speed 700
tuy nhiên sẽ bị lạc giọng.

Hoặc nhờ bác batman1 sử dụng Argument ttsspeed=0.14 để giảm tốc độ đọc không bị lạc giọng đọc:
http://translate.google.com/translate_tts?ie=utf-8&client=tw-ob&tl=vi&ttsspeed=0.14&q=Xin mời quý khách mang số 0 1 2 3 Vui lòng đến quầy

Function InsertText(ByVal str As String,Optional Byval Text As String = " ") As String
InsertText=Trim( Replace(StrConv(str, vbUnicode), vbNullChar ,Text))
End Sub
bảng tính em từ B3:B5000 anh đưa em code nói thật là bó tay .com em chả biết áp dụng làm sao. dù sao cũng cảm ơn anh nhiều

Bài đã được tự động gộp: 3/4/20

Tại tôi không thích dùng vòng lặp, bạn chạy lại code này:

Function tach(ByVal str As String) As String
For i = 1 To Len(str)
    tach = tach & " " & Mid(str, i, 1)
Next
End Function
Sub a()
Dim arr, i As Long: arr = Range("b3:b" & Cells(Rows.Count, "b").End(xlUp).Row)
For i = 1 To UBound(arr)
    arr(i, 1) = Trim(tach(arr(i, 1)))
Next
[c3].Resize(UBound(arr), 1) = arr
End Sub

Bài đã được tự động gộp: 3/4/20

Không cần phải xét điều kiện len()=1 , dùng trim cắt là được bạn ạ.

Đã test code bị lỗi nó xóa luôn vùng dữ liệu ban đầu của em luôn

 

[HieuCD]

Em chào các anh chị. Vừa rồi em có hỏi bài đọc Âm Thanh từ số của Thầy Batman1 . code đọc rất hay. nhưng có điều nó đọc hơi nhanh, khiến người ta nghe không kịp. em đã thử thêm dấu cách vào giửa các con số thì nó đọc từng số rõ ràng.
Nên nhờ mọi người giúp mình thêm 1 ký tự nào đó vào xen kẽ giữa chuổi thì phải làm sao. em cảm ơn ạ

em xin mô phỏng qua hình ảnh cho mọi người hiểu ạ . Ví dụ em muốn làm cho Vùng B3:B6 sang vùng C3:C6
Mình cần Sub để gán vào nút bấm chứ không cần Function do file mình hơn 5000 dòng ( tương ứng 5000 mã số bệnh nhân cách ly )


View attachment 234661

Sửa trực tiếp trên code của @Batman1 là ổn nhất

 

[HeSanbi]

Function InsertText(ByVal str As String,Optional Byval Text As String = " ") As String
InsertText=Trim( Replace(StrConv(str, vbUnicode), vbNullChar ,Text))
End Sub
bảng tính em từ B3:B5000 anh đưa em code nói thật là bó tay .com em chả biết áp dụng làm sao. dù sao cũng cảm ơn anh nhiều

---------------------------


Bạn copy cái này vào code của bác batman1 mà bạn muốn đấy.

Sau đó xem cái "B..." ... .Value nằm chỗ nào

Rồi InsertText(Range("B..").Value)

Rồi lần sau mà bạn muốn thay đổi ký tự thì
InsertText(Range("B..").Value, "---")

Có một bài đọc tiếng Việt mà bạn chia nhỏ ra hỏi như vậy. Bạn thử hỏi "ông" Admin xem, có hay hay không?

 

[VetMini]

Sửa trực tiếp trên code của @Batman1 là ổn nhất

Bạn không thể hiểu nổi đề tài của thớt đâu. Nhờ gì làm nấy chứ bàn tới bàn lui coi chừng bị chê là dốt đấy.

 

[HieuCD]

Bạn không thể hiểu nổi đề tài của thớt đâu. Nhờ gì làm nấy chứ bàn tới bàn lui coi chừng bị chê là dốt đấy.

Bạn đừng lo, Mazda6 chưa bao giờ chê mình, các từ Hán Việt chưa chắc đọc suông sẽ