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

Liên hệ QC
1

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
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
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
vu_tuan_manh_linh đã viết:
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
Nhấp chuột vào đây để mở rộng...

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
vu_tuan_manh_linh đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
phuocam đã viết:
Mã: 
'...
        Range("A1:J3000").Replace What:=tmp1, Replacement:=tmp2, LookAt:=xlPart
        Range("A1:J3000").Replace What:=UCase(tmp1), Replacement:=UCase(tmp2), LookAt:=xlPart
...
Nhấp chuột vào đây để mở rộng...
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
phuocam đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
phuocam đã viết:
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
Nhấp chuột vào đây để mở rộng...
code quá hay cháu cảm ơn
Bài đã được tự động gộp:

Quochuyhdbt đã viết:
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
Nhấp chuột vào đây để mở rộng...
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:

VetMini đã viết:
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
Nhấp chuột vào đây để mở rộng...
cháu cảm ơn bác nhiều
 
Upvote 0
Quochuyhdbt đã viết:
mãng
Nhấp chuột vào đây để mở rộng...
"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).
Quochuyhdbt đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
1+1=2 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
HieuCD đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

Tuấn Bụng Bự
  • Question
Tìm Bộ 8 số xuất hiện nhiều nhất trong random( 1 - 80)
2
Trả lời
32
Đọc
805
VetMini
V
K
Nhờ mọi người hoàn thiện giúp công thức
Trả lời
4
Đọc
86
kiendt1973
K
GPE-Trợ Lý
MỪNG NGÀY NHÀ GIÁO VIỆT NAM 20/11/2024
    • Thích
    • Yêu thích
Trả lời
0
Đọc
49
GPE-Trợ Lý
GPE-Trợ Lý
dovanha1994
Giúp e tìm nguyên nhân sai và hướng dẫn e đọc file này với ạ
    • Phẫn nộ
Trả lời
3
Đọc
92
dovanha1994
dovanha1994
N
Giúp sửa mã code
Trả lời
19
Đọc
399
ptm0412
ptm0412
P
Nhờ giúp đỡ hàm lọc dữ liệu theo tỉnh
Trả lời
10
Đọc
160
Parabol
P
CodyPham97
tạo biểu tượng thay thế nhấn đúp chuột
Trả lời
1
Đọc
47
BuiQuangThuan
B
H
Chúc mừng 20/11- ngày tôn vinh nhà giáo Việt Nam.
    • Thích
    • Yêu thích
Trả lời
0
Đọc
54
HUONGHCKT
H
F
  • Question
Nhờ tư vấn cách tạo QR trong Excel
Trả lời
4
Đọc
443
hoangtuan.net
hoangtuan.net
N
Vẽ biểu đồ kết hợp nhiều yếu tố trong excel
Trả lời
7
Đọc
188
Ny Ny 2024
N
20050911
File Excel lỗi ''The file could not be accessed. Try one of the following:.."
Trả lời
9
Đọc
455
bibuzz90
B
Nhật Anh 9x
  • Question
Tính tồn cuối kỳ luỹ kế cho nhiều mã
Trả lời
2
Đọc
94
Nhật Anh 9x
Nhật Anh 9x
H
Hỗ trợ lấy danh sách dữ liệu thỏa mãn điều kiện
Trả lời
1
Đọc
77
bebo021999
B
C
Chia sẻ: Kết quả xổ số Keno
    • Cười
    • Thích
2
Trả lời
20
Đọc
560
ptm0412
ptm0412
nguyen trung cuong
File chứa marco không mở được.
Trả lời
2
Đọc
70
nguyen trung cuong
nguyen trung cuong
huynhnhu1234
Tìm giá vé máy bay một chiều và khứ hồi
Trả lời
1
Đọc
106
hvnhpro
H
nobita994
Trừ số lượng dần theo dòng khi quét Sumif tổng có tên sản phẩm bị trùng.
Trả lời
2
Đọc
75
bebo021999
B
PhanTuHuong
Bàn về môn thể thao bóng bàn nào!
    • Thích
    • Yêu thích
    • Cười
2
Trả lời
37
Đọc
2K
cantl
C
S
  • Question
Xin file excel bảng giá quần áo, trang phục, phụ kiện
Trả lời
2
Đọc
77
VetMini
V
P
Tổng hợp dữ liệu từ các sheet theo chọn lọc
Trả lời
19
Đọc
384
VetMini
V
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom