Cách cắt dấu tiếng việt cho 1 vùng bằng SUB

Liên hệ QC

1+1=2

Thành viên bị đình chỉ hoạt động
Thành viên bị đình chỉ hoạt động
Tham gia
5/7/20
Bài viết
62
Được thích
12
Cháu chào mọi người. Cháu có dùng code sau để cắt dấu mà nó đang là công thức chỉ áp dụng từng ô và gây nặng bảng tính khi nhiều dòng. Giờ cháu muốn chuyển sang viết Sub gán vào nút bấm bấm cái rẹt là ra luôn thì phải lam sao. cháu cảm ơn nhiều

1594722401954.png

Mã:
Function TV(ByVal Text As String) As String
    On Error Resume Next
    Dim CharCode, ResText As String, i As Long, tmp As String
    tmp = Text
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
        tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
    Next
    TV = tmp
End Function
 
Bạn nghiên cứu vòng lặp for next nhé.
PHP:
Dim Cll as range
Application.ScreenUpdate=False
Application.Caculation=XlManual
For each Cll in Selection
Cll.value=TV(Cll.value)
next
Application.ScreenUpdate=True
Application.Caculation=XlAutomatic
 
Upvote 0
Bạn nghiên cứu vòng lặp for next nhé.
PHP:
Dim Cll as range
Application.ScreenUpdate=False
Application.Caculation=XlManual
For each Cll in Selection
Cll.value=TV(Cll.value)
next
Application.ScreenUpdate=True
Application.Caculation=XlAutomatic

cảm ơn anh. 10 cột *3000 dòng hơi chậm anh à mất 1 phút
 
Lần chỉnh sửa cuối:
Upvote 0
Bạn nghiên cứu vòng lặp for next nhé.
PHP:
Dim Cll as range
Application.ScreenUpdate=False
Application.Caculation=XlManual
For each Cll in Selection
Cll.value=TV(Cll.value)
next
Application.ScreenUpdate=True
Application.Caculation=XlAutomatic
Cái hàm CV kia được viết theo kiểu chỉ gọi một vài lần.
Nếu phải dùng vòng lặp gọi nhiều lần thì nó cần được viết lại cho chạy khá hơn.
Điển hình:
1. biến chỉ chứa trị hằng thì dùng trên bộ nhớ ụ (heap) chứ không dùng bộ nhớ ngăn xếp (stack)
2. nếu chuỗi ngắn thì dùng cách duyệt khác.
 
Upvote 0
Mã:
Sub Macro1()
Dim CharCode, ResText As String, i As Long
Dim tmp1 As String
Dim tmp2 As String
Dim t As Double
t = Timer

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp1 = CharCode(i)
        tmp2 = Mid(ResText, i + 1, 1)
        Range("A1:J3000").Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
        Range("A1:J3000").Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
    Next
MsgBox Timer - t
End Sub
 
Upvote 0
Mã:
'...
        Range("A1:J3000").Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
        Range("A1:J3000").Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
...
Sub BoDauVung(rg As Range)
...
rg.Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
rg.Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
...
End Sub

Sub Macro1()
BoDauVung Range("A1:J3000")
End Sub
 
Upvote 0
Mã:
Sub Macro1()
Dim CharCode, ResText As String, i As Long
Dim tmp1 As String
Dim tmp2 As String
Dim t As Double
t = Timer

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp1 = CharCode(i)
        tmp2 = Mid(ResText, i + 1, 1)
        Range("A1:J3000").Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
        Range("A1:J3000").Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
    Next
MsgBox Timer - t
End Sub
Code hay quá mà Sao đang duyệt mãng mà vùng bạn không duyệt mãng luôn mà dùng Find chi nhỉ ?
Bài đã được tự động gộp:

Mã:
Sub Macro2()
Dim CharCode, ResText As String, i As Long
Dim tmp1 As String
Dim tmp2 As String
Dim vung, x As Long, y As Long
Dim t As Double
t = Timer

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    vung = Range("A1:J3000")
    For i = 0 To UBound(CharCode)
        tmp1 = CharCode(i)
        tmp2 = Mid(ResText, i + 1, 1)
        For x = LBound(vung, 1) To UBound(vung, 1)
            For y = LBound(vung, 2) To UBound(vung, 2)
                If InStr(1, (vung(x, y)), (tmp1), 1) > 0 Then
                vung(x, y) = Replace(Replace(vung(x, y), tmp1, tmp2), UCase(tmp1), UCase(tmp2))
                End If
            Next y
        Next x
    Next i
    NumRows = UBound(vung, 1) - LBound(vung, 1) + 1
    NumCols = UBound(vung, 2) - LBound(vung, 2) + 1
    Range("L1").Resize(NumRows, NumCols).Value = vung
    Set vung = Nothing
MsgBox Timer - t
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Mã:
Sub Macro1()
Dim CharCode, ResText As String, i As Long
Dim tmp1 As String
Dim tmp2 As String
Dim t As Double
t = Timer

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp1 = CharCode(i)
        tmp2 = Mid(ResText, i + 1, 1)
        Range("A1:J3000").Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
        Range("A1:J3000").Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
    Next
MsgBox Timer - t
End Sub
code quá hay cháu cảm ơn
Bài đã được tự động gộp:

Code hay quá mà Sao đang duyệt mãng mà vùng bạn không duyệt mãng luôn mà dùng Find chi nhỉ ?
Bài đã được tự động gộp:

Mã:
Sub Macro2()
Dim CharCode, ResText As String, i As Long
Dim tmp1 As String
Dim tmp2 As String
Dim vung, x As Long, y As Long
Dim t As Double
t = Timer

    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    vung = Range("A1:J3000")
    For i = 0 To UBound(CharCode)
        tmp1 = CharCode(i)
        tmp2 = Mid(ResText, i + 1, 1)
        For x = LBound(vung, 1) To UBound(vung, 1)
            For y = LBound(vung, 2) To UBound(vung, 2)
                If InStr(1, (vung(x, y)), (tmp1), 1) > 0 Then
                vung(x, y) = Replace(Replace(vung(x, y), tmp1, tmp2), UCase(tmp1), UCase(tmp2))
                End If
            Next y
        Next x
    Next i
    NumRows = UBound(vung, 1) - LBound(vung, 1) + 1
    NumCols = UBound(vung, 2) - LBound(vung, 2) + 1
    Range("L1").Resize(NumRows, NumCols).Value = vung
    Set vung = Nothing
MsgBox Timer - t
End Sub
code quá hay cháu cảm ơn. Code của chú cháu thấy tốc độ rất nhanh. Cháu cảm ơn chú nhiều
Bài đã được tự động gộp:

Sub BoDauVung(rg As Range)
...
rg.Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
rg.Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
...
End Sub

Sub Macro1()
BoDauVung Range("A1:J3000")
End Sub
cháu cảm ơn bác nhiều
 
Upvote 0
"mảng" (trong từ: mảng mây, mảng màu, mảng cơm cháy... là tập hợp các phần tử) chứ không phải "mãng" (trong từ: mãng xà, một loại rắn có nọc cực độc).
For x = LBound(vung, 1) To UBound(vung, 1)
For y = LBound(vung, 2) To UBound(vung, 2)
If InStr(1, (vung(x, y)), (tmp1), 1) > 0 Then
'...
MsgBox Timer - t
Muốn đếm thời gian và " mà dùng Find chi " thì cần thêm khoảng 5 biến nữa.
 
Upvote 0
_)()(-tớ đang học " mảng " nên mới ngấm được chút ít .
Cậu phát hiện được gì thì post cho tớ và mọi người học với nhé
 
Lần chỉnh sửa cuối:
Upvote 0
Cháu chào mọi người. Cháu có dùng code sau để cắt dấu mà nó đang là công thức chỉ áp dụng từng ô và gây nặng bảng tính khi nhiều dòng. Giờ cháu muốn chuyển sang viết Sub gán vào nút bấm bấm cái rẹt là ra luôn thì phải lam sao. cháu cảm ơn nhiều

View attachment 241127

Mã:
Function TV(ByVal Text As String) As String
    On Error Resume Next
    Dim CharCode, ResText As String, i As Long, tmp As String
    tmp = Text
    CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                     ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                     ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                     ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                     ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                     ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                     ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                     ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                     ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
    ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
    For i = 0 To UBound(CharCode)
        tmp = Replace(tmp, CharCode(i), Mid(ResText, i + 1, 1))
        tmp = Replace(tmp, UCase(CharCode(i)), UCase(Mid(ResText, i + 1, 1)))
    Next
    TV = tmp
End Function
Giảm bớt số lần xử lý
Mã:
Sub ABC()
  Dim sArr(), CharCode, ResText$
  Dim Tmp$, uTmp$, Tmp2$, uTmp2$, sTr$
  Dim sChar&, sRow&, sCol&, n&, i&, j&
  Dim t As Double
  t = Timer
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                    ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                    ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                    ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                    ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                    ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                    ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                    ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  sChar = UBound(CharCode)
  
  sArr = Range("A2:J3000").Value
  sRow = UBound(sArr): sCol = UBound(sArr, 2)
  For n = 0 To sChar
    Tmp = CharCode(n):      Tmp2 = Mid(ResText, n + 1, 1)
    uTmp = UCase(Tmp):      uTmp2 = UCase(Tmp2)
    For i = 1 To sRow
      For j = 1 To sCol
        sTr = sArr(i, j)
        If InStr(1, sTr, (Tmp)) Then
          If InStr(1, sTr, (uTmp)) Then
            sArr(i, j) = Replace(Replace(sTr, uTmp, uTmp2), Tmp, Tmp2)
          Else
            sArr(i, j) = Replace(sTr, Tmp, Tmp2)
          End If
        ElseIf InStr(1, sTr, (uTmp)) Then
            sArr(i, j) = Replace(sTr, uTmp, uTmp2)
        End If
      Next j
    Next i
  Next n
  Range("L2").Resize(sRow, sCol).Value = sArr
  MsgBox Timer - t
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
Giảm bớt số lần xử lý
Mã:
Sub ABC()
  Dim sArr(), CharCode, ResText$
  Dim Tmp$, uTmp$, Tmp2$, uTmp2$, sTr$
  Dim sChar&, sRow&, sCol&, n&, i&, j&
  Dim t As Double
  t = Timer
  CharCode = Array(ChrW(7855), ChrW(7857), ChrW(7859), ChrW(7861), ChrW(7863), ChrW(7845), ChrW(7847), _
                    ChrW(7849), ChrW(7851), ChrW(7853), ChrW(225), ChrW(224), ChrW(7843), ChrW(227), ChrW(7841), _
                    ChrW(259), ChrW(226), ChrW(273), ChrW(7871), ChrW(7873), ChrW(7875), ChrW(7877), ChrW(7879), _
                    ChrW(233), ChrW(232), ChrW(7867), ChrW(7869), ChrW(7865), ChrW(234), ChrW(237), ChrW(236), _
                    ChrW(7881), ChrW(297), ChrW(7883), ChrW(7889), ChrW(7891), ChrW(7893), ChrW(7895), ChrW(7897), _
                    ChrW(7899), ChrW(7901), ChrW(7903), ChrW(7905), ChrW(7907), ChrW(243), ChrW(242), ChrW(7887), _
                    ChrW(245), ChrW(7885), ChrW(244), ChrW(417), ChrW(7913), ChrW(7915), ChrW(7917), ChrW(7919), _
                    ChrW(7921), ChrW(250), ChrW(249), ChrW(7911), ChrW(361), ChrW(7909), ChrW(432), ChrW(253), _
                    ChrW(7923), ChrW(7927), ChrW(7929), ChrW(7925))
  ResText = "aaaaaaaaaaaaaaaaadeeeeeeeeeeeiiiiiooooooooooooooooouuuuuuuuuuuyyyyy"
  sChar = UBound(CharCode)

  sArr = Range("A1:J3000").Value
  sRow = UBound(sArr): sCol = UBound(sArr, 2)
  For n = 0 To sChar
    Tmp = CharCode(n):      Tmp2 = Mid(ResText, n + 1, 1)
    uTmp = UCase(Tmp):      uTmp2 = UCase(Tmp2)
    For i = 1 To sRow
      For j = 1 To sCol
        sTr = sArr(i, j)
        If InStr(1, sTr, (Tmp)) Then sArr(i, j) = Replace(sTr, Tmp, Tmp2)
        If InStr(1, sTr, (uTmp)) Then sArr(i, j) = Replace(sTr, uTmp, uTmp2)
      Next j
    Next i
  Next n
  Range("L1").Resize(sRow, sCol).Value = sArr
  MsgBox Timer - t
End Sub
cháu cảm ơn chú nhiều lắm. code chạy rất đúng và nhanh. mà có điều cháu đọc chưa hiểu thuật toán. ráng cố gắng học chứ giờ biết sao giờ
 
Upvote 0
Tác giả bài #5 và #11:
Độ mượt của code còn tuỳ thuộc vào độ dài trung bình của mỗi chuỗi.

Giải thuật thay tại chỗ (nếu chuỗi ngắn - trung bình khoảng 20 ký tự, và phương sai không lớn lắm):

chrCde = Join(CharCode, "") & Join(Split(UCase(Join(CharCode, " ")), " "), "") ' gồm chuỗi Lcase và Ucase
resTxt = ResText & UCase(ResText)
For Each cll In theRange ' nếu range nhỏ thì làm thẳng trên range
txt = cll.Value
For i = 1 To Len(txt)
pos = InStr(chrCde, Mid(txt, i, 1))
If pos Then Mid(txt, i, 1) = Mid(resTxt, pos, 1)
Next i
cll.Value = txt
Next cll
 
Upvote 0
Web KT
Back
Top Bottom