Nhờ check Macro Find and replace all file excel

Liên hệ QC
8

881516

Thành viên chính thức
Tham gia
8/6/16
Bài viết
80
Được thích
6
Chào ace
Em có tìm đc 1 đoạn code chia sẻ trên microsoft và e đang cần sử dụng nó.
Mục đích: tìm và thay thế 1 đoạn văn bản trong nhiều file excel trong 1 thư mục cùng lúc.
hiện tại e đang gặp lỗi
1. sau khi load file excel nhưng ko replace được, ko hiện thông báo done
2. không gõ tiếng việt vào ô tìm kiếm và thay thế đc.
(e đã enable editing all file)
Nhờ ace chỉ giúp ạ
Link gốc: https://answers.microsoft.com/en-us...a/deb409ac-8467-4648-a44d-f1dd47b7d45d?auth=1
Mã: 
Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
Lần chỉnh sửa cuối:
mọi người giúp e với ạ :(
 
Mình tự làm 1 ví dụ vậy, ở đây có 5 file
File FNR là file chứa macro.
4 file còn lại là file cần thay đổi dữ liệu

Chạy macro:
step 1: nhập dữ liệu cần tìm và thay
step 2: nhập dữ liệu thay thế
step 3: chọn đường dẫn thư mục chứa các file excel cần xử lý.

Ví dụ: cần đổi Việt Nam trong các file thành Campuchia

Lỗi: nhập Việt Nam ko hiển thị tiếng việt đc, chạy xong step 3, các file có load nhưng ko có kết quả

Mong mọi người xem giúp
(sorry máy e ko winrar file lại đc)
 

File đính kèm

  • 1.xlsx
    8.6 KB · Đọc: 9
  • 2.xlsx
    8.6 KB · Đọc: 9
  • 3.xlsx
    8.6 KB · Đọc: 6
  • 4.xlsx
    8.6 KB · Đọc: 5
  • Find and replace.xlsm
    18.5 KB · Đọc: 15
881516 đã viết:
Chào ace
Em có tìm đc 1 đoạn code chia sẻ trên microsoft và e đang cần sử dụng nó.
Mục đích: tìm và thay thế 1 đoạn văn bản trong nhiều file excel trong 1 thư mục cùng lúc.
hiện tại e đang gặp lỗi
1. sau khi load file excel nhưng ko replace được, ko hiện thông báo done
2. không gõ tiếng việt vào ô tìm kiếm và thay thế đc.
(e đã enable editing all file)
Nhờ ace chỉ giúp ạ
Link gốc: https://answers.microsoft.com/en-us...a/deb409ac-8467-4648-a44d-f1dd47b7d45d?auth=1
Mã: 
Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
Khi chạy xong thì làm gì có thông báo nào, code không có đoạn đó. để viết tiếng việt thid thay cái inputbox bằng application.inputbox("nhap",type:=2)
 
881516 đã viết:
Chào ace
Em có tìm đc 1 đoạn code chia sẻ trên microsoft và e đang cần sử dụng nó.
Mục đích: tìm và thay thế 1 đoạn văn bản trong nhiều file excel trong 1 thư mục cùng lúc.
hiện tại e đang gặp lỗi
1. sau khi load file excel nhưng ko replace được, ko hiện thông báo done
2. không gõ tiếng việt vào ô tìm kiếm và thay thế đc.
(e đã enable editing all file)
Nhờ ace chỉ giúp ạ
Link gốc: https://answers.microsoft.com/en-us...a/deb409ac-8467-4648-a44d-f1dd47b7d45d?auth=1
Mã: 
Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = InputBox("Enter text to find")
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = InputBox("Enter replacement text")
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
        For Each wsh In wbk.Worksheets
            wsh.Cells.Replace What:=strFind, Replacement:=strReplace, _
                LookAt:=xlWhole, MatchCase:=False
        Next wsh
        wbk.Close SaveChanges:=True
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Code này chạy mỗi lần bạn input một text và nó sẽ mở từng file để thay. Điều này khá nguy hiểm vì không kiểm soát được code nó chạy đúng hay không, thay có phù hợp hay không. Và riêng việc mở, lưu, mở lưu như vậy cũng đã khiến excel mắc mệt rồi.

Mình gợi ý bạn một cách.
1. Tạo một file chứa từ khóa cần thay thế.
2. Tạo một giao diện xác nhận thay thế, một bên chứa dữ liệu load được, một bên chứa khung xác nhận.
3. Khi code bạn hoạt động nó sẽ load ra các dữ liệu tìm kiếm được, sau đó nó liệt kê ra và cho bạn thông tin đích đến để kiểm tra nếu cần.
4. Nếu bạn thấy Ok nhấn Update nó sẽ thay thế cho bạn.
5. Nâng cao hơn thì có thể viết auto, nhưng mắc mệt.

Đoạn code trên với trường hợp của bạn đơn giản thì được, xử lý phức tạp thì không xài đc.
 
moctriet đã viết:
Code này chạy mỗi lần bạn input một text và nó sẽ mở từng file để thay. Điều này khá nguy hiểm vì không kiểm soát được code nó chạy đúng hay không, thay có phù hợp hay không. Và riêng việc mở, lưu, mở lưu như vậy cũng đã khiến excel mắc mệt rồi.

Mình gợi ý bạn một cách.
1. Tạo một file chứa từ khóa cần thay thế.
2. Tạo một giao diện xác nhận thay thế, một bên chứa dữ liệu load được, một bên chứa khung xác nhận.
3. Khi code bạn hoạt động nó sẽ load ra các dữ liệu tìm kiếm được, sau đó nó liệt kê ra và cho bạn thông tin đích đến để kiểm tra nếu cần.
4. Nếu bạn thấy Ok nhấn Update nó sẽ thay thế cho bạn.
5. Nâng cao hơn thì có thể viết auto, nhưng mắc mệt.

Đoạn code trên với trường hợp của bạn đơn giản thì được, xử lý phức tạp thì không xài đc.
Nhấp chuột vào đây để mở rộng...
Mình cũng chỉ cần xử lý text đơn giản thôi, file cũng nhẹ nên và ko sợ bị ảnh hưởng, thực tế file mình download về, chỉ sửa để in nên ko nặng vấn đề dữ liệu
Đoạn code mình lấy từ nguồn microsoft chứ cũng ko biết viết.
Nếu đc nhờ bạn hoàn chỉnh giúp mình.
Cảm ơn bạn :D
 
881516 đã viết:
Mình cũng chỉ cần xử lý text đơn giản thôi, file cũng nhẹ nên và ko sợ bị ảnh hưởng, thực tế file mình download về, chỉ sửa để in nên ko nặng vấn đề dữ liệu
Đoạn code mình lấy từ nguồn microsoft chứ cũng ko biết viết.
Nếu đc nhờ bạn hoàn chỉnh giúp mình.
Cảm ơn bạn :D
Nhấp chuột vào đây để mở rộng...
Bạn sửa lại thế này thử xem được chưa.
Mã: 
Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = Application.InputBox("Enter text to find", Type:=2)
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = Application.InputBox("Enter replacement text", Type:=2)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
            For Each wsh In wbk.Worksheets
                    wsh.Cells.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Next wsh
            wbk.Close SaveChanges:=True
        End If
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
 
giaiphap đã viết:
Bạn sửa lại thế này thử xem được chưa.
Mã: 
Sub ReplaceInFolder()
    Dim strPath As String
    Dim strFile As String
    Dim wbk As Workbook
    Dim wsh As Worksheet
    Dim strFind As String
    Dim strReplace As String
    strFind = Application.InputBox("Enter text to find", Type:=2)
    If strFind = "" Then
        MsgBox "No find text specified!", vbExclamation
        Exit Sub
    End If
    strReplace = Application.InputBox("Enter replacement text", Type:=2)
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show Then
            strPath = .SelectedItems(1)
        Else
            MsgBox "No folder selected!", vbExclamation
            Exit Sub
        End If
    End With
    If Right(strPath, 1) <> "\" Then
        strPath = strPath & "\"
    End If
    Application.ScreenUpdating = False
    strFile = Dir(strPath & "*.xls*")
    Do While strFile <> ""
        If strFile <> ThisWorkbook.Name Then
            Set wbk = Workbooks.Open(Filename:=strPath & strFile, AddToMRU:=False)
            For Each wsh In wbk.Worksheets
                    wsh.Cells.Replace What:=strFind, Replacement:=strReplace, LookAt:=xlPart, _
                            SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
            Next wsh
            wbk.Close SaveChanges:=True
        End If
        strFile = Dir
    Loop
    Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Góp ý là cách input text trực tiếp không dùng được cho tiếng việt đâu. Nên cách tốt nhất bạn nên chọn text từ cell của Excel
Ví dụ code bên dưới mình demo cho bạn.

Private Sub f6789y29494keflsdfbsm()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "fafasfasgagagaga"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

If WorkRng = "" Then
MsgBox "No find text specified!", vbExclamation
Exit Sub
Else
Range("A1").Value = WorkRng
End If
End Sub
 
Đe
moctriet đã viết:
Góp ý là cách input text trực tiếp không dùng được cho tiếng việt đâu. Nên cách tốt nhất bạn nên chọn text từ cell của Excel
Ví dụ code bên dưới mình demo cho bạn.

Private Sub f6789y29494keflsdfbsm()
Dim Rng As Range
Dim WorkRng As Range
On Error Resume Next
xTitleId = "fafasfasgagagaga"
Set WorkRng = Application.Selection
Set WorkRng = Application.InputBox("Range", xTitleId, WorkRng.Address, Type:=8)

If WorkRng = "" Then
MsgBox "No find text specified!", vbExclamation
Exit Sub
Else
Range("A1").Value = WorkRng
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Để mình thử cách của bạn, cách của bạn #6 viết đc tiếng việt bạn ah
 
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

A
Đếm dữ liệu với điều kiện
Trả lời
7
Đọc
45
bebo021999
B
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
28
Đọc
2K
DeTong
D
T
V/v tối ưu xử lý đoạn code
Trả lời
4
Đọc
128
huhumalu
H
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
16
Đọc
372
giaiphap
giaiphap
H
Xin giúp đỡ lấy lại file excel bị lưu đè
Trả lời
5
Đọc
112
befaint
befaint
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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