[Help] Tạo Macro xử lý lỗi chính tả (1 người xem)

robinhsoon · 1/4/17

Chào cộng đồng giaiphapexcel!
Mình làm phiền mấy bạn tạo giúp mình Macro như bên dưới nhé:
Mình có một File Data, gồm 02 Sheet (Data và Err)..
Tại Sheet Err gồm 02 cột
+ Erro: là những từ mình khai báo bị lỗi chính tả bên Sheet Data
+ Edit: là những từ đươc sửa lỗi chính tả
Mình muốn tạo một Macro có thể lấy được những từ mình khai báo tại sheet Err qua bên Sheet Data... Vì công việc của mình cần đòi hỏi phải check lỗi chính tả nhiều, Check bằng mắt rất tốn nhiều thời gian...
Mong các bạn giúp mình để mình có thể hoàn thành công việc này một cách tốt nhất nhé...
Cảm ơn các bạn.. Mong các bạn giúp đỡ

ChanhTQ@ · 1/4/17

Bạn thử với macro này:

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            Set tRg = Union(tRg, sRng)
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

robinhsoon · 1/4/17

ChanhTQ@ đã viết:

Bạn thử với macro này:

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            Set tRg = Union(tRg, sRng)
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

Cảm ơn Anh nhiều nha!.. nhờ đoạn code này công việc của em sẽ nhanh hơn

robinhsoon · 2/4/17

ChanhTQ@ đã viết:

Bạn thử với macro này:

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            Set tRg = Union(tRg, sRng)
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

Chào anh ChánhTQ, đoạn code của anh có chút trục trặc ak,... Trong data của em có những từ đứng trước và sau những từ cần thây thế thì nó bỏ luôn những từ đó vậy anh..
Ví dụ: QUAN CA PHE WIFI thì nó thây thế CHỈ CÓ TỪ CAFE thôi.. em thì muốn những từ đứng trước hay sau những từ thây đổi đó vẫn giữ nguyên.
ví dụ như: QUAN CA PHE WIFI thì QUAN CAFE WIFI..
Mong anh giúp đỡ em nhé..

robinhsoon · 2/4/17

có cao thủ nào giúp mình không ạ?

Hoang2013 · 2/4/17

Tại bạn thôi: Trong file giả lập chỉ tuyền thay thế toàn bộ chứ không à!

Có cao thủ nào giúp mình không ạ?

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String, CCau As String
 Dim VTr As Byte
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            If Len(Cls.Value) = Len(sRng.Value) Then
                Set tRg = Union(tRg, sRng)
            Else
                VTr = InStr(sRng.Value, Cls.Value)
                CCau = Mid(sRng.Value, VTr + Len(Cls.Value), Len(sRng.Value))
                If VTr = 1 Then
                    sRng.Value = Cls.Offset(, 1).Value & CCau
                ElseIf VTr > 1 Then
                    sRng.Value = Left(sRng.Value, VTr - 1) & Cls.Offset(, 1).Value & CCau
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

robinhsoon · 2/4/17

Hoang2013 đã viết:

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String, CCau As String
 Dim VTr As Byte
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            If Len(Cls.Value) = Len(sRng.Value) Then
                Set tRg = Union(tRg, sRng)
            Else
                VTr = InStr(sRng.Value, Cls.Value)
                CCau = Mid(sRng.Value, VTr + Len(Cls.Value), Len(sRng.Value))
                If VTr = 1 Then
                    sRng.Value = Cls.Offset(, 1).Value & CCau
                ElseIf VTr > 1 Then
                    sRng.Value = Left(sRng.Value, VTr - 1) & Cls.Offset(, 1).Value & CCau
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

Đoạn code của bạn mình bỏ vào không chạy được, bạn xem giúp mình nó có bị lỗi gì không nhé... Cảm ơn bạn đã quan tâm đến bài viết này và mong sự giúp đỡ của bạn..

Hoang2013 · 2/4/17

File bài #1 của bạn chỉ gồm 2 cột [G:H] là chứa dữ liệu cần sửa mà thôi

Còn file bài #7 này thì 2 cột này là những con số chứa trong chúng thì qua thế giới bên kia cũng không chạy nữa là!

Bạn tự sửa Code đi theo file mới của bạn.

Tạm biệt!

robinhsoon · 2/4/17

Hoang2013 đã viết:
File bài #1 của bạn chỉ gồm 2 cột [G:H] là chứa dữ liệu cần sửa mà thôi

Còn file bài #7 này thì 2 cột này là những con số chứa trong chúng thì qua thế giới bên kia cũng không chạy nữa là!

Bạn tự sửa Code đi theo file mới của bạn.

Tạm biệt!

Cảm ơn bạn Hoang2013 đã nhiệt tình giúp đỡ mình và mình cũng vừa phát hiện ra mình đã sửa teamplate nên đoạn code không chạy được... Nhưng....
Khi mình sửa lại như #1 thì có 02 lỗi mình gặp phải đó là:
1. xuất hiện thông báo lỗi như hình bên dưới mình đã đính kèm.
2. khi mình khai báo (Sheet Err - Cột Err) bằng số: 2 là DA NANG và 23 LÀ DIEN BIEN khi chạy Macro thì nó chỉ lấy toàn bô là DA NANG
Mong bạn giúp đỡ nhé..

SA_DQ · 3/4/17

Với dữ liệu như vậy thì không fải là chuyện lỗi chính tả nữa rồi!

Đó là vấn đề nhập liệu sao cho nhanh & chính xác.

Còn chuyện bạn coi đó là lỗi chính tả thì không thể tiếp tục viết macro để hết lỗi này đẻ lỗi khác được nữa đâu.

Vĩnh biệt!

robinhsoon · 3/4/17

SA_DQ đã viết:
Với dữ liệu như vậy thì không fải là chuyện lỗi chính tả nữa rồi!

Đó là vấn đề nhập liệu sao cho nhanh & chính xác.

Còn chuyện bạn coi đó là lỗi chính tả thì không thể tiếp tục viết macro để hết lỗi này đẻ lỗi khác được nữa đâu.

Vĩnh biệt!

Chào Anh! cảm ơn anh đã quan tâm đến bài viết của em..
Đây không phải là vấn đề nhập liệu ạ... vì nguồn Data em đã có sẵn và công việc của em là check và sửa chữa những lỗi chính tả đó cho đúng và đồng nhất, sau một thời gian em làm và phát hiện những từ thường bị lỗi chính tả lập đi lập lại, nên em mới nghỉ ra cách này để làm công việc của em nhanh hơn... Nếu được mong anh giúp đỡ... Về lỗi thứ 2 mà em nói thì cái đó em dùng để Vlookup lấy những chữ thay thế cho số ak, nhưng khi bỏ vào tool thì nó không hoạt động như em muốn (bỏ lỗi này).. Giúp em sửa lỗi 1 nhé!

.. Cảm ơn anh nhiều

SA_DQ · 3/4/17

. . .
Khi mình sửa lại như #1 thì có 02 lỗi mình gặp phải đó là:
1. xuất hiện thông báo lỗi như hình bên dưới mình đã đính kèm.
2. khi mình khai báo (Sheet Err - Cột Err) bằng số: 2 là DA NANG và 23 LÀ DIEN BIEN khi chạy Macro thì nó chỉ lấy toàn bô là DA NANG
Mong bạn giúp đỡ nhé..

1) Không nhìn rõ hình, nên không dám fát biểu;

2) Để vượt qua vấn đề này, bạn cần lập bảng tra như sau:

10 Hà Nội
11 Đà Nẵng
12 TP Hồ Chí Minh
. . . . .

Còn nếu danh sách tra đến hơn trăm từ thì fải xài kiểu

100 Hồ 2úi Ly
101 Hứa Như Cuội
102 Trần Như Nhộng
103 Bảo Định Giang
. . . .
987 Trần Văn Trà

Chúc thành công!

robinhsoon · 3/4/17

HYen17 đã viết:
1) Không nhìn rõ hình, nên không dám fát biểu;

2) Để vượt qua vấn đề này, bạn cần lập bảng tra như sau:

10 Hà Nội
11 Đà Nẵng
12 TP Hồ Chí Minh
. . . . .

Còn nếu danh sách tra đến hơn trăm từ thì fải xài kiểu

100 Hồ 2úi Ly
101 Hứa Như Cuội
102 Trần Như Nhộng
103 Bảo Định Giang
. . . .
987 Trần Văn Trà

Chúc thành công!

Cảm ơn anh nhé..! còn lỗi 1 nữa em vẫn chưa giải quyết được

robinhsoon · 3/4/17

Hoang2013 đã viết:

PHP:

Sub TimVaThayThe()
 Dim Sh As Worksheet, Rng As Range, sRng As Range, Cls As Range, tRg As Range
 Dim MyAdd As String, CCau As String
 Dim VTr As Byte
 
 Sheets("link Erro").Select
 Set Sh = ThisWorkbook.Worksheets("Data")
 Set Rng = Sh.Columns("G:H")
 For Each Cls In Range([A2], [A2].End(xlDown))
    Set sRng = Rng.Find(Cls.Value, , xlFormulas, xlPart)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Set tRg = sRng
        Do
            If Len(Cls.Value) = Len(sRng.Value) Then
                Set tRg = Union(tRg, sRng)
            Else
                VTr = InStr(sRng.Value, Cls.Value)
                CCau = Mid(sRng.Value, VTr + Len(Cls.Value), Len(sRng.Value))
                If VTr = 1 Then
                    sRng.Value = Cls.Offset(, 1).Value & CCau
                ElseIf VTr > 1 Then
                    sRng.Value = Left(sRng.Value, VTr - 1) & Cls.Offset(, 1).Value & CCau
                End If
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not tRg Is Nothing Then
        tRg.Value = Cls.Offset(, 1).Value
        Set tRg = Nothing
    End If
 Next Cls
End Sub

Chào Anh Hoàng!
em đã sửa lại giá trị của cột cần sửa, nhưng khi chạy code lại xuất hiện lỗi như file em đính kèm.. em mò hoài nhưng không ra, anh vui lòng em sửa lỗi này nhé.. cảm ơn anh

ndu96081631 · 4/4/17

robinhsoon đã viết:
Chào Anh Hoàng!
em đã sửa lại giá trị của cột cần sửa, nhưng khi chạy code lại xuất hiện lỗi như file em đính kèm.. em mò hoài nhưng không ra, anh vui lòng em sửa lỗi này nhé.. cảm ơn anh

Sửa toàn bộ code trên thành vầy xem:

Mã:

Sub FindAndReplace()
  Dim aDict,  rngData As Range
  Dim sTmpFind As String, sTmpReplace As String
  Dim lR As Long
  With Sheets("link Erro")
    aDict = .Range("A2", .Range("B60000").End(xlUp))
  End With
  Set rngData = Sheets("Data").Range("A2:A1000")
  For lR = 1 To UBound(aDict, 1)
    sTmpFind = aDict(lR, 1): sTmpReplace = aDict(lR, 2)
    rngData.Replace sTmpFind, sTmpReplace, xlPart, , False
  Next
End Sub

robinhsoon · 4/4/17

ndu96081631 đã viết:

Sửa toàn bộ code trên thành vầy xem:

Mã:

Sub FindAndReplace()
  Dim aDict,  rngData As Range
  Dim sTmpFind As String, sTmpReplace As String
  Dim lR As Long
  With Sheets("link Erro")
    aDict = .Range("A2", .Range("B60000").End(xlUp))
  End With
  Set rngData = Sheets("Data").Range("A2:A1000")
  For lR = 1 To UBound(aDict, 1)
    sTmpFind = aDict(lR, 1): sTmpReplace = aDict(lR, 2)
    rngData.Replace sTmpFind, sTmpReplace, xlPart, , False
  Next
End Sub

Cảm ơn anh nhiều nha... nhờ anh mà em làm được rồi ạ.. Chúc anh sức khỏe và thành công nhé

[Help] Tạo Macro xử lý lỗi chính tả (1 người xem)

Người dùng đang xem chủ đề này

Thành viên hoạt động

File đính kèm

0901452không62

Thành viên hoạt động

Thành viên hoạt động

Thành viên hoạt động

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

/(hông là gì!

Thành viên hoạt động

/(hông là gì!

Thành viên hoạt động

Thành viên hoạt động

File đính kèm

Huyền thoại GPE

Thành viên hoạt động

Đếm ngược thời gian