so sánh và thay thế

[thuy nhu nguyen]

Xin chào cách anh/ chị em trong diễn đàn.
E gặp vướng mắc ở nội dung dưới đây mong được mọi người giúp đỡ.
- em có 2 bảng như dưới đây và cần thay thế chữ tiếng Trung Quốc ở cột bên trái bằng chữ Tiếng Việt ở bảng A khi có từ ở bảng A trùng với cột bên trái.
Và không dùng Ctrl + F để tìm và thay thế vì dữ liệu ở Bảng A của em rất là nhiều.
Xin cảm ơn.

-

 

[cantl]

Mid
Index
Textjoin
Copy
Paste

 

[ptm0412]

Và không dùng Ctrl + F để tìm và thay thế vì dữ liệu ở Bảng A của em rất là nhiều.

Tôi dùng Ctrl H chứ không dùng ctrl F. Và dù nhiều đến đâu cũng chỉ mất 1 giây cho 1 từ

 

[VetMini]

Tôi dùng Ctrl H chứ không dùng ctrl F. Và dù nhiều đến đâu cũng chỉ mất 1 giây cho 1 từ

3600 từ mất hết 1 tiếng.
Mấy cô chiêu cậu ấm thời nay vài giây là coi như "lâu" rồi.

Nếu có code VBA, "bấm một phát" khỏe ru.

 

[cantl]

Tôi dùng Ctrl H chứ không dùng ctrl F. Và dù nhiều đến đâu cũng chỉ mất 1 giây cho 1 từ

Với một số chị em bên ngoài, thì thỉnh thoảng vẫn có ít tình trạng Ctrl+F, rồi chọn tab H bác ạ.

bấm một phát

Bài này nếu em, chắc em cũng nghĩ đến cách của bác trước.

 

[ptm0412]

3600 từ mất hết 1 tiếng.

Xem hình thì chỉ chừng 2 chục từ thôi. Dữ liệu bảng bên trái mới nhiều, mà nhiều bao nhiêu cũng chỉ 1 giây mỗi từ ờ bảng bên phải.
Nếu thực sự bảng bên phải lên đến ngàn từ thì tôi mới nghĩ đến chuyện bấm 1 phát.

 

[bebo021999]

Bấm nút "THAY THẾ" nhé

Option Explicit
Sub thaythe()
Dim i&, j&, rng, id As String, st As String
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("G5:H" & Cells(Rows.Count, "G").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    If Not dic.exists(rng(i, 1)) Then dic.Add rng(i, 1), rng(i, 2)
Next
rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    st = ""
    For j = 1 To Len(rng(i, 1))
        id = Mid(rng(i, 1), j, 1)
        If id <> " " Then
            If dic.exists(id) Then
                st = IIf(st = "", "", st & " ") & dic(id)
            Else
                st = IIf(st = "", "", st & " ") & id
            End If
        End If
    Next
    rng(i, 1) = st
Next
Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value = rng
End Sub

 

[VetMini]

...
Nếu thực sự bảng bên phải lên đến ngàn từ thì tôi mới nghĩ đến chuyện bấm 1 phát.

Ba cái đồ trăng hoa này tôi không buồn viết code bạn ạ.
Tôi đăng ký một cái tên Lê Thị Mỹ Miều, tìm một cái hình tài tử Mã lai xinh xinh để đó.
Mỗi lần có chuyện nhỏ nhặt như vầy cứ việc đăng lên hỏi và tải code về.

Code có thể sử dụng nhiều lần, cho vào thư viện, tôi mới bỏ công viết. Loại công việc chỉ làm một lần rồi bỏ thì nhờ GPE làm giùm cho khỏe.

 

[thuy nhu nguyen]

Cảm ơn các anh chị rất nhiều vì đã giúp đỡ em. dữ liệu của em nó rơi vào khoảng 1 triệu dòng, và từ cần thay thế kia của em là giống như @VetMini đó ạ, chứ không phải như cái bảng ạ.
Do em cũng dân tay ngang nên xử lý dữ liệu excel ko biết toàn phải vào diễn đàn đọc - làm theo. Lần này bí quá nên em mới phải đăng bài đấy ạ.
em cảm ơn @bebo021999 @cantl lắm luôn ạ.

 

[ptm0412]

Ba cái đồ trăng hoa này tôi không buồn viết code bạn ạ.
Code có thể sử dụng nhiều lần, cho vào thư viện, tôi mới bỏ công viết. Loại công việc chỉ làm một lần rồi bỏ thì nhờ GPE làm giùm cho khỏe.

Tôi cũng định không trăng hoa, nhưng một là nghĩ có khi phải xài nhiều lần, và hai là thấy ghét cái bài #7 xài đao to búa lớn quá, nên bỏ 1 phút viết và 3 phút test. Ngó cũng giống record macro ...

Sub ReplaceWord()
Dim SData As Range, RepArr(), LastRw As Long
LastRw = [A100000].End(xlUp).Row
Set SData = Range("A1:A" & LastRw)
LastRw = [G1000].End(xlUp).Row
RepArr = Range("G5:H" & LastRw).Value
For i = 1 To UBound(RepArr, 1)
    SData.Replace RepArr(i, 1), RepArr(i, 2) & " "
Next
End Sub

 

[thuy nhu nguyen]

@bebo021999 code của bác chạy ok mà em bị vỡ chữ là nguyên nhân tại sao vậy bác?

Bấm nút "THAY THẾ" nhé

Option Explicit
Sub thaythe()
Dim i&, j&, rng, id As String, st As String
Dim dic As Object, key
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("G5:H" & Cells(Rows.Count, "G").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    If Not dic.exists(rng(i, 1)) Then dic.Add rng(i, 1), rng(i, 2)
Next
rng = Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    st = ""
    For j = 1 To Len(rng(i, 1))
        id = Mid(rng(i, 1), j, 1)
        If id <> " " Then
            If dic.exists(id) Then
                st = IIf(st = "", "", st & " ") & dic(id)
            Else
                st = IIf(st = "", "", st & " ") & id
            End If
        End If
    Next
    rng(i, 1) = st
Next
Range("A1:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value = rng
End Sub

Bài đã được tự động gộp: 10/1/23

Tôi cũng định không trăng hoa, nhưng một là nghĩ có khi phải xài nhiều lần, và hai là thấy ghét cái bài #7 xài đao to búa lớn quá, nên bỏ 1 phút viết và 3 phút test. Ngó cũng giống record macro ...

Sub ReplaceWord()
Dim SData As Range, RepArr(), LastRw As Long
LastRw = [A100000].End(xlUp).Row
Set SData = Range("A1:A" & LastRw)
LastRw = [G1000].End(xlUp).Row
RepArr = Range("G5:H" & LastRw).Value
For i = 1 To UBound(RepArr, 1)
    SData.Replace RepArr(i, 1), RepArr(i, 2) & " "
Next
End Sub

code này của bác em còn chưa dám thử vì trình em còn hổng bít add vô lm sao luôn

 

[bebo021999]

View attachment 285624
@bebo021999 code của bác chạy ok mà em bị vỡ chữ là nguyên nhân tại sao vậy bác?

Chắc vì chạy code 2 lần, định sửa mà lười quá. Bạn dùng code "trăng hoa" của sư phụ Ptm ở #10 được rồi. Nếu không được nữa thì mình đành quay lại sửa vậy. (Alt-F11 mở cửa sổ VBA, rồi nhấn insert/ macro, dán nó vô, nhấn F5 để chạy code)

 

[ptm0412]

Chắc vì chạy code 2 lần, định sửa mà lười quá.

Chỗ else thêm " " làm chi ...

 

[bebo021999]

Chỗ else thêm " " làm chi ...

Có khoảng trắng để tránh nối từ thành nghĩa khác sư phụ ơi

 

[thuy nhu nguyen]

@bebo021999 @ptm0412 hai bác để lại email hoặc làm cách nào để nhắn tin trực tiếp cá nhân dc ko?
để cảm ơn hai bác đã nhiệt tình hết mức e muốn mời 2 bác 1 ly cafe cho ngày mới thêm hứng khởi thôi chứ không có gì to tát cả. email e: nhuthuy668@gmail.com

 

[ptm0412]

Có khoảng trắng để tránh nối từ thành nghĩa khác sư phụ ơi

Hậu quả là cứ mỗi ký tự chèn 1 khoảng trắng á.
Ở đây nè:

id = Mid(rng(i, 1), j, 1)
'id = từng ký tự
        If id <> " " Then
            If dic.exists(id) Then
                st = IIf(st = "", "", st & " ") & dic(id)
            Else
                st = IIf(st = "", "", st & " ") & id
                'Từng ký tự id đều được nối khoảng trắng dù if hay else
'thiếu else của if id <> " "

hai bác để lại email hoặc làm cách nào để nhắn tin trực tiếp cá nhân dc ko?

Bạn sửa code bebo câu else thành như sau là được. Đừng xài code của tôi tốn cafe (không phải tôi uống mà là bạn uống chờ code chạy xong)

   Else
          st = IIf(st = "", "", st & "") & id
'(đổi khoảng trắng thành chuỗi rỗng)
Else
   st = st & id
'Thêm else trước End If dưới

 

[VetMini]

.... Loại công việc chỉ làm một lần rồi bỏ thì nhờ GPE làm giùm cho khỏe.

... nghĩ có khi phải xài nhiều lần,....

1. Trước mắt là đối với tôi chỉ 1 lần. Nhưng có một số người khác nghĩ là nhiều lần.
2. Trước mắt là đối với tôi là trò trăng hoa. Nhưng với người khác là dịp múa ngón tay gõ phím.
Đạt cả hai yếu tố trên tôi mới có code để mà chép chứ.

 

[ptm0412]

Đạt cả hai yếu tố trên tôi mới có code để mà chép chứ.

Thì tôi cũng 2 yếu tố: Yếu tố thứ 2 là thấy code đáng ghét. Nhưng may, nó không đến nỗi quá đáng ghét đối với bảng 2 trên 1 ngàn như file bài #11.