Cải thiện nội dung code tìm và điền dữ liệu từ excel sang word

nguoidien

Thành viên mới
Nội dung cần thực hiện:
mở file word mẫu
tìm trong file word các nội dung có dạng <<địa chỉ ô>> và thay thế nội dung đó, lấy từ file ecxel có địa chỉ ô tương ứng
ví dụ: trong file word có <<B2>> thì trong file excel lấy dữ liệu tại ô B2 thay thế vào đó sau cùng save as lại thành tên file khác

Vấn đề bị vướng là
1. Nếu càng nhiều cột thì phải lặp lại 1 đoạn
.Text = "<<A" & i & ">>"
.Replacement.Text = Sheet21.Range("A" & i).Text
.Execute Replace:=2
nhiều lần

Khi file word nhiều ký tự (như một báo cáo dài tầm 10 trang) và số cột dữ liệu nhiều (khoảng 50 cột - cột AX chẳng hạn) thì lặp lại đoạn code này 50 lần thì kì quá

2. Khi i = 100 trở lên thì chạy đoạn code rất chậm đợi rất lâu

Bên dưới là đoạn code như nội dung miêu tả trên, tìm từ dòng 1 đến dòng 100 và từ cột A đến cột F


Mã:
'
Sub DienBaoCao()
    Dim WordApp As Object
    Dim WordDoc As Object
    Dim WordContent As Object
    Dim i As Long

    Set WordApp = CreateObject("Word.Application")
    WordApp.Visible = True
    Set WordDoc = WordApp.Documents.Open("D:\bc.docx")
    Set WordContent = WordDoc.Content

    For i = 1 To 100

    With WordContent.Find
       
        .Text = "<<A" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2
          
        .Text = "<<B" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2

        .Text = "<<C" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2

        .Text = "<<D" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2

        .Text = "<<E" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2

        .Text = "<<F" & i & ">>"
        .Replacement.Text = Sheet21.Range("A" & i).Text
        .Execute Replace:=2

      '''tuong tu cho cac cot khac tu G -->den AH

    End With
    Next i

    WordDoc.SaveAs Filename:="D:\bc_1.docx"
    Set WordDoc = Nothing
    Set WordApp = Nothing
End Sub



p/s: rất xin lỗi các mem và ad vì lần đầu đăng bài nên chưa thạo lắm, nội dung hơi khó hiểu làm phiền các bạn
 
Sửa lần cuối:

tuhocvba

Administrator
Thành viên BQT
Không có tóm tắt chương trình làm gì, cũng như không có hình ảnh minh hoạ, file demo. Quả thật là không muốn đọc một topic như thế này . Mong bạn cải thiên.
 
Top