Chuyên đề giải đáp những thắc mắc về code VBA

Liên hệ QC

maytinhvp01

Thành viên thường trực
Tham gia
27/7/13
Bài viết
390
Được thích
179
Mình muốn nhờ giải thich câu lệnh " If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c) "
trong ví du:
Public Function LonNhat(Ran As Range)
Dim max As Double, v As Integer, d As Integer, c As Integer
max = Ran.Cells(1, 1)
For d = 1 To Ran.Rows.Count
For c = 1 To Ran.Columns.Count
If Ran.Cells(d, c) > max Then max = Ran.Cells(d, c)
Next c
Next d
v = Tim(max, Ran)
LonNhat = max
End Function
-------------------------------------------------------
[INFO1]Thông báo:
Vì topic này:
http://www.giaiphapexcel.com/forum/...ải-thích-các-code-đề-nghị-các-bạn-gửi-vào-đây
đã quá dài nên BQT đóng lại.
Nay tôi mở topic mới với cùng chủ đề: GIẢI THÍCH NHỮNG THẮC MẮC VỀ CODE
Các bạn nếu có nhu cầu giải thích code, vui lòng post tại đây nhé
NDU96081631

[/INFO1]
 
Chỉnh sửa lần cuối bởi điều hành viên:
Code đây ạ
X.Worksheets(1).Range("H2").End(xlUp).Offset(1, 0).Value = KH.Text
X.Worksheets(1).Range("G2").End(xlUp).Offset(1, 0).Value = MDH.Text
X.Worksheets(1).Range("I2").End(xlUp).Offset(1, 0).Value = TH.Text
X.Worksheets(1).Range("J2").End(xlUp).Offset(1, 0).Value = VT.Text
X.Worksheets(1).Range("Y2").End(xlUp).Offset(1, 0).Value = NCC.Text
Khi nhấn NEXT thi những dữ liệu nhập trên Form sẽ nhập tiếp vào các dòng H3,G3,I2,... của sheet ChiTiet
Em đóng new workbook tại nút OK là vì sẽ có những báo giá chỉ có 1 dòng thôi
Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.
 
Lần chỉnh sửa cuối:
Upvote 0
Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.
Bài bên này em đằn lên hỏi khoảng 3 4 ngày trước rồi mà ko thấy ai trả lời với có người bảo em nên tạo topic mới để dễ theo dõi nên em mới tạo thêm. Anh thông cảm dùm em nha. Rất cám ơn sự giúp đỡ nhiệt tình của anh. Anh qua bài bên kia giúp em tiếp tục nha. E test thử rồi mà nó báo lỗi, em gửi lại file anh kiểm tra lại dùm em nha
Tôi xóa bài này vì bạn hỏi 2 nơi. Sang "bên kia" mà chờ nhé.
 

File đính kèm

  • 2019 - TEST 1.xlsm
    39 KB · Đọc: 5
  • BG mau.xls
    235 KB · Đọc: 4
Upvote 0
Hi ae, nhờ anh em viết giùm mình đoạn code sau để lọc dữ liệu từ 1 bảng khoảng vài trăm nghìn dòng:
Cho i chạy từ 2 đến 1000000
Với từng i: Nếu ô Ai chứa ký tự dấu ngoặc trái "(" hoặc ô Hi có giá trị <0 hoặc ô Ji có giá trị khác #N/A thì xóa dữ liệu dòng i.Nếu không thỏa điều kiện trên thì sẽ xuống dòng tiếp theo.
Mình mới mày mò VBA, chỉ có thể ghi lại macro để dùng, chưa biết viết code. Nhờ ae giúp đỡ :)
 
Upvote 0
Chào cả nhà,
Mình đang làm một số công việc cần trích xuất dữ liệu excel rất nhiều ra các biểu mẫu word. Mình có tìm hiểu trên mạng và lượm được 1 đoạn code theo video như sau. tuy nhiên khi mình chạy thử code chỉ tạo ra các biểu mấu mới chứ không điền dữ liệu vào được. công việc gấp và mình cũng chưa có kiến thức vba cơ bản, mong các bạn trong diễn đàn trợ giúp. Cảm ơn các bạn nhiều!
code:
Mã:
Sub bbntcv()
Dim num_of_cust As Long
Dim num_of_column As Long
Dim i As Long, j As Long
Dim template As Object
Dim t As Object

num_of_column = 14

num_of_cust = Sheet6.Cells(Rows.Count, "A").End(xlUp).Row - 1
With CreateObject("word.application")
.Visible = True

For i = 1 To num_of_cust
Set template = .documents.Open("C:\Users\NGHIALT\Desktop\New folder\BBNTCV.doc")
Set t = template.Content
For j = 1 To num_of_column
t.Find.Execute _
FindText:=Sheet6.Cells(1, j).Value, _
ReplaceWith:=Sheet6.Cells(i + 1, j).Value, _
Replace:=wdReplaceAll
Next
template.SaveAs Filename:=ThisWorkbook.Path & Application.PathSeparator & i & "-BBNTCV.doc"
Next
.Quit
End With
Set t = Nothing
Set template = Nothing

End Sub
 

File đính kèm

  • BBNTCV.doc
    47.5 KB · Đọc: 5
  • List bien ban.xls
    304.5 KB · Đọc: 5
Upvote 0
Chào cả nhà,
Mình đang làm một số công việc cần trích xuất dữ liệu excel rất nhiều ra các biểu mẫu word. Mình có tìm hiểu trên mạng và lượm được 1 đoạn code theo video như sau. tuy nhiên khi mình chạy thử code chỉ tạo ra các biểu mấu mới chứ không điền dữ liệu vào được. công việc gấp và mình cũng chưa có kiến thức vba cơ bản, mong các bạn trong diễn đàn trợ giúp. Cảm ơn các bạn nhiều!
code:
Bạn đã vi phạm nội qui khi gửi 2 bài có cùng nội dung ở 2 nơi.

Hãy xóa bài trong chủ đề này, để lại 1 bài thôi.
 
Lần chỉnh sửa cuối:
Upvote 0
Bài bên này em đằn lên hỏi khoảng 3 4 ngày trước rồi mà ko thấy ai trả lời với có người bảo em nên tạo topic mới để dễ theo dõi nên em mới tạo thêm. Anh thông cảm dùm em nha. Rất cám ơn sự giúp đỡ nhiệt tình của anh. Anh qua bài bên kia giúp em tiếp tục nha. E test thử rồi mà nó báo lỗi, em gửi lại file anh kiểm tra lại dùm em nha
Tôi tưởng tôi xóa kịp nhưng hóa ra bạn đã kịp copy bài của tôi.

Tôi gõ thiếu.
Sửa
Mã:
owb = sPath & A & "." & B & "." & C & ".xlsx"
thành

Mã:
owb_filename = sPath & A & "." & B & "." & C & ".xlsx"

Tức sửa owb thành owb_filename.

Do nút NEXT mở tập tin được tạo bởi nút OK nên thứ tự phải là click OK, sau đó mới click NEXT
 
Upvote 0
Tôi tưởng tôi xóa kịp nhưng hóa ra bạn đã kịp copy bài của tôi.

Tôi gõ thiếu.
Sửa
Mã:
owb = sPath & A & "." & B & "." & C & ".xlsx"
thành

Mã:
owb_filename = sPath & A & "." & B & "." & C & ".xlsx"

Tức sửa owb thành owb_filename.

Do nút NEXT mở tập tin được tạo bởi nút OK nên thứ tự phải là click OK, sau đó mới click NEXT
Dạ bài post của bác gửi lên mail nên em mới có ạ . Thank ạ
 
Upvote 0
mình muốn xóa topic ngoài kia nhưng k tìm đc nút xóa, mong mod xóa giúm topic. Cảm ơn!
Thôi được, tôi liều vậy. Nếu người ta xóa trong chủ đề này thì coi như là tôi mất công.

Nguyên nhân thì nhìn thấy ngay thôi.

t.Find.Execute _

FindText:=Sheet6.Cells(1, j).Value, _

ReplaceWith:=Sheet6.Cells(i + 1, j).Value, _

Replace:=wdReplaceAll


wdReplaceAll là hằng số của Word. Nếu code chạy bên Word thì nó biết là wdReplaceAll = 2. Nhưng code chạy bên Excel nên nó không biết wdReplaceAll là gì, nên nó cho đấy là tên của biến, mà biến đó không được khai báo tường minh. Do không có thiết lập giá trị cho "biến" này nên nó có giá trị bằng 0. Khi đối tượng t.Find của Word thực hiện phương thức Execute thì nó gặp số 0 cho Replace. Mà 0 ở bên Word có ý nghĩa là wdReplaceNone (wdReplaceNone = 0), tức KhôngThaythế. Vì thế chả có chỗ nào được thay thế bằng giá trị từ Excel.


Tóm lại, sau dòng Sub bbntcv() thì phải thêm dòng

Mã:
Const wdReplaceAll = 2


Lúc này thì đã "điền dữ liệu vào được". Tuy nhiên có vài chỗ sẽ phải sửa:


1. Bên Excel có D1 = "[[shh]] ". Tức thừa dấu cách. Khi đổi sang Word thì thời gian "dính" với từ "ngày" ở sau nó.


2. shh và ehh khi sang Word sẽ không là dạng 7:00 mà là 0,291666... Vì thời gian, ngày tháng chẳng qua là số.


3. I2 = 0,155273368606702, và số thập phân này sẽ hiển thị Word, tức có vd.


Thực tế

0,155273368606702


Nếu là chưa có kiến thức vba cơ bản thì tại sao lại dùng VBA? Bạn biết trộn thư - mail merge không?
 
Upvote 0
Thôi được, tôi liều vậy. Nếu người ta xóa trong chủ đề này thì coi như là tôi mất công.

Nguyên nhân thì nhìn thấy ngay thôi.




wdReplaceAll là hằng số của Word. Nếu code chạy bên Word thì nó biết là wdReplaceAll = 2. Nhưng code chạy bên Excel nên nó không biết wdReplaceAll là gì, nên nó cho đấy là tên của biến, mà biến đó không được khai báo tường minh. Do không có thiết lập giá trị cho "biến" này nên nó có giá trị bằng 0. Khi đối tượng t.Find của Word thực hiện phương thức Execute thì nó gặp số 0 cho Replace. Mà 0 ở bên Word có ý nghĩa là wdReplaceNone (wdReplaceNone = 0), tức KhôngThaythế. Vì thế chả có chỗ nào được thay thế bằng giá trị từ Excel.


Tóm lại, sau dòng Sub bbntcv() thì phải thêm dòng

Mã:
Const wdReplaceAll = 2


Lúc này thì đã "điền dữ liệu vào được". Tuy nhiên có vài chỗ sẽ phải sửa:


1. Bên Excel có D1 = "[[shh]] ". Tức thừa dấu cách. Khi đổi sang Word thì thời gian "dính" với từ "ngày" ở sau nó.


2. shh và ehh khi sang Word sẽ không là dạng 7:00 mà là 0,291666... Vì thời gian, ngày tháng chẳng qua là số.


3. I2 = 0,155273368606702, và số thập phân này sẽ hiển thị Word, tức có vd.


Thực tế

0,155273368606702


Nếu là chưa có kiến thức vba cơ bản thì tại sao lại dùng VBA? Bạn biết trộn thư - mail merge không?
Cảm ơn bạn, tối qua mày mò mình cũng đã chỉnh sửa để code có thể chạy tạm được rồi :)
Tuy nhiên mình cũng mạn phép muốn thắc mắc thêm thêm 1 số vấn đề mong được mod và các bạn giải đáp.
Do yêu cầu công việc mình cần xử lý 1 số lượng văn bản dạng này rất lớn trong thời gian ngắn. mình thấy phương pháp sử dụng vba sẽ hữu ích hơn nhiều và cũng muốn tìm hiểu thêm về vba nên mạn phép qua đây học hỏi cùng mọi người, mong mod thông cảm.
thứ nhất:
về vấn đề định dạng 7:00 thành 0,291666... mình đã xử lý bằng cách thay thế việc lấy giá trị .Value thành lấy văn bản .Text:
Mã:
FindText:=Sheet6.Cells(1, j).Text, _
ReplaceWith:=Sheet6.Cells(i + 1, j).Text,
thứ 2:
mình muốn tối ưu hóa code này thêm 1 chút, bằng việc có thể xuất file ra theo từng dòng (hoặc 1 vài dòng) mình muốn, không biết mod cũng như các bạn có thể giúp đỡ mình không. trân trọng!
 
Upvote 0
mình muốn tối ưu hóa code này thêm 1 chút, bằng việc có thể xuất file ra theo từng dòng (hoặc 1 vài dòng) mình muốn, không biết mod cũng như các bạn có thể giúp đỡ mình không. trân trọng!
Tôi nghĩ là VBA làm được nhưng chỉ nói chung chung "từng dòng (hoặc 1 vài dòng)" thì không ai hiểu bạn muốn gì.
 
Upvote 0
Hi ae, nhờ anh em viết giùm mình đoạn code sau để lọc dữ liệu từ 1 bảng khoảng vài trăm nghìn dòng:
Cho i chạy từ 2 đến 1000000
Với từng i: Nếu ô Ai chứa ký tự dấu ngoặc trái "(" hoặc ô Hi có giá trị <0 hoặc ô Ji có giá trị khác #N/A thì xóa dữ liệu dòng i.Nếu không thỏa điều kiện trên thì sẽ xuống dòng tiếp theo.
Mình mới mày mò VBA, chỉ có thể ghi lại macro để dùng, chưa biết viết code. Nhờ ae giúp đỡ :)
Nếu dữ liệu nhiều như vậy thì nên dùng ADO thì hơn?
Bạn đưa ít dữ liệu giả định (Template phải chuẩn) lên để mọi người giúp cho?
 
Upvote 0
Tôi nghĩ là VBA làm được nhưng chỉ nói chung chung "từng dòng (hoặc 1 vài dòng)" thì không ai hiểu bạn muốn gì.
tức là code này giúp mình xuất ra tất cả các bản ghi (file word) cho 1 click, mỗi bản ghi tương ứng với 1 dòng dữ liệu mình có trong bảng excel. ý tưởng của mình là trong trường hợp mình chỉ muốn xuất 1 bản ghi tương ứng với dòng dữ liệu đầu tiên hoặc 3 bản ghi tương ứng với dòng dữ liệu 5,8,16 (giống như việc mình print all hay print page đó) thì có thể không? trân trọng!
 
Upvote 0
tức là code này giúp mình xuất ra tất cả các bản ghi (file word) cho 1 click, mỗi bản ghi tương ứng với 1 dòng dữ liệu mình có trong bảng excel. ý tưởng của mình là trong trường hợp mình chỉ muốn xuất 1 bản ghi tương ứng với dòng dữ liệu đầu tiên hoặc 3 bản ghi tương ứng với dòng dữ liệu 5,8,16 (giống như việc mình print all hay print page đó) thì có thể không? trân trọng!
Tôi hiểu 5,8,16 là chỉ số dòng trên sheet của dòng dữ liệu cần lấy.

Thế 5,8,16 bạn nhập ở đâu? Hay là hiện InputBox để nhập?

Bạn quá kiệm lời. Bạn muốn người khác viết code cho cả 2 trường hợp? Vì nếu không người ta chỉ viết cho 1 trường hợp thì bạn sẽ nói là bạn muốn trường hợp 2 và người ta lại sửa?

Nếu vấn đề là của mình thì mình nên chăm hơn tất cả các người khác, bỏ công càng nhiều để những người sẽ giúp mình bỏ công ra càng ít.

Tôi làm cho cách 1: nhập 5,8,16 hoặc 5, 8, 16 vào NTCV!Q1 (tự sửa trong code nếu nhập chỗ khác), tập tin Excel và Word đặt trong cùng thư mục.
Mã:
Sub bbntcv()
Const wdReplaceAll = 2
    Dim dong
    Dim num_of_column As Long
    Dim k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    num_of_column = 14
    
    With Sheet6.Range("Q1")
        If Trim(.Value) = "" Then Exit Sub
        dong = Split(Trim(.Value), ",")
    End With
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = Trim(dong(i))
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                t.Find.Execute findtext:=Sheet6.Cells(1, j).Value, ReplaceWith:=Sheet6.Cells(k, j).Text, Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & i & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
    
End Sub
 
Upvote 0
Tôi hiểu 5,8,16 là chỉ số dòng trên sheet của dòng dữ liệu cần lấy.

Thế 5,8,16 bạn nhập ở đâu? Hay là hiện InputBox để nhập?

Bạn quá kiệm lời. Bạn muốn người khác viết code cho cả 2 trường hợp? Vì nếu không người ta chỉ viết cho 1 trường hợp thì bạn sẽ nói là bạn muốn trường hợp 2 và người ta lại sửa?

Nếu vấn đề là của mình thì mình nên chăm hơn tất cả các người khác, bỏ công càng nhiều để những người sẽ giúp mình bỏ công ra càng ít.

Tôi làm cho cách 1: nhập 5,8,16 hoặc 5, 8, 16 vào NTCV!Q1 (tự sửa trong code nếu nhập chỗ khác), tập tin Excel và Word đặt trong cùng thư mục.
Mã:
Sub bbntcv()
Const wdReplaceAll = 2
    Dim dong
    Dim num_of_column As Long
    Dim k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    num_of_column = 14
  
    With Sheet6.Range("Q1")
        If Trim(.Value) = "" Then Exit Sub
        dong = Split(Trim(.Value), ",")
    End With
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = Trim(dong(i))
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                t.Find.Execute findtext:=Sheet6.Cells(1, j).Value, ReplaceWith:=Sheet6.Cells(k, j).Text, Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & i & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
  
End Sub
Lời đầu tiên mình rất cảm ơn bạn đã nhiệt tình giúp đỡ mình, do kiến thức còn hạn chế nên chưa thể truyền đạt rõ ý để bạn hiểu, mình rất xin lỗi về điều này.
Mình có gửi lại file mình đã chỉnh sửa code và sử dụng được lên để bạn có thể hiểu rõ hơn tình huống của mình.
nếu có thể check giùm mình bạn hãy sửa phần đường dẫn lại cho đúng khi bạn download về máy bạn giúp mình nhé (2 file để dùng 1 thư mục)
Hiện tại khi nhấp vào "xuat file" code của mình sẽ chạy và cho ra 1 loạt file kết quả ở cùng thư mục chưa file excel nguồn, mỗi dòng là 1 file kết quả (word). ý tưởng của mình là khi mình nhấp vào "xuat file" excel sẽ đưa ra cho mình 2 option là "xuất tất cả các dòng" hay "xuất dòng x" (x do mình nhập vào, theo mình hiểu thì là dạng InputBox như bạn nói). Rất mong được bạ giúp đỡ. Trân trọng!
 

File đính kèm

  • BBNTCV.doc
    47.5 KB · Đọc: 13
  • List bien ban.xls
    312 KB · Đọc: 14
Upvote 0
Có bác nào rảnh code hộ em tự động xuất file theo địa chỉ thư mục có sãn được không ạ ( em có thể về chỉnh sửa )
Thank các bác
 

File đính kèm

  • help.xlsx
    7.9 KB · Đọc: 3
Upvote 0
Hiện tại khi nhấp vào "xuat file" code của mình sẽ chạy và cho ra 1 loạt file kết quả ở cùng thư mục chưa file excel nguồn, mỗi dòng là 1 file kết quả (word). ý tưởng của mình là khi mình nhấp vào "xuat file" excel sẽ đưa ra cho mình 2 option là "xuất tất cả các dòng" hay "xuất dòng x" (x do mình nhập vào, theo mình hiểu thì là dạng InputBox như bạn nói). Rất mong được bạ giúp đỡ. Trân trọng!
Biết ngay mà. Lại phải viết lần nữa.

̣Thôi, làm lần cuối. Tập tin Ecel và Word ở cùng thư mục. Để nguyên "all" và nhấn OK hoặc nhập vd. 2, 5, 8 (2,5,8) và nhấn OK. Code không kiểm tra lỗi nhập vd. 2.3, 5, 8 hoặc 1234 khi dữ liệu chỉ có tới dòng vd. 200
Mã:
Sub bbntcv()
Const wdReplaceAll = 2
    Dim indexs As String, dong, data()
    Dim num_of_column As Long
    Dim lastRow As Long, k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    With Sheet6
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
    End With
    indexs = InputBox("Hay nhap cac chi so dong tren sheet hoac de nguyen ""all"" va nhan OK", "Nhap chi so dong", "all")
    If indexs = "" Then Exit Sub
    
    data = Sheet6.Range("A1:N" & lastRow).Value
    
    If indexs = "all" Then
        ReDim dong(0 To UBound(data) - 2)
        For k = 0 To UBound(dong)
            dong(k) = k + 2
        Next k
    Else
        dong = Split(Replace(indexs, " ", ""), ",")
    End If
    
    num_of_column = 14
    
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = dong(i)
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                If j = 4 Or j = 5 Then
                    data(k, j) = Format(data(k, j), "HH:mm")
                ElseIf j = 9 Then
                    data(k, j) = Round(data(k, j), 3)
                End If
                t.Find.Execute findtext:=data(1, j), ReplaceWith:=data(k, j), Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & k & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
    
End Sub
 
Upvote 0
Sau khi đọc bài Tổng quan về Dictionary của anh kyo , em nghĩ nó rất phù hợp để đẩy nhanh tiến độ công việc của bản thân nhưng khi áp dụng vẫn chưa thành công, em mạn phép gửi code của em lên để các anh xem nó ko phù hợp ở chỗ nào. Mục đích của em là :

- Tạo một Dictionary có cột A của file Data làm key, cột B, I (trong code em vẫn chưa có làm cột I) làm Item.
- Nạp Dictionary từ file Main, sau đó lấy cột AG làm giá trị cần tìm, làm tương tự như vlookup để xuất giá trị ở cột DD=B, cột DE = I.(Code nằm ở Module 1).

Mong các anh có thể sửa và giải thích giúp cho em để em ghi nhớ ạ. Em xin cảm ơn trước.
 
Upvote 0
Sau khi đọc bài Tổng quan về Dictionary của anh kyo , em nghĩ nó rất phù hợp để đẩy nhanh tiến độ công việc của bản thân nhưng khi áp dụng vẫn chưa thành công, em mạn phép gửi code của em lên để các anh xem nó ko phù hợp ở chỗ nào. Mục đích của em là :

Mong các anh có thể sửa và giải thích giúp cho em để em ghi nhớ ạ. Em xin cảm ơn trước.
Bạn thử xem.

Đừng hỏi gì nữa vì tôi chú thích từng dòng code rồi.
Mã:
Sub thudictionary()
Dim wb As Workbook, ws As Worksheet
Dim data(), result(), dic, item
Dim i As Long, lastRow As Long
'    tap tin Main.xlsb va Data.xlsm o trong cung thu muc
    Set wb = Application.Workbooks.Open(ThisWorkbook.Path & "\Data.xlsm")
    With wb.Worksheets("Master in Google Drive")
        lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
'        khong co du lieu thi ket thuc
        If lastRow < 2 Then Exit Sub
'        lay du lieu vao mang data
        data = .Range("A2:I" & lastRow).Value
    End With
    wb.Close
    
'    kiem tra xem VNSO co du lieu hay khong
    Set ws = ThisWorkbook.Sheets("VNSO")
    With ws
'        neu co ket qua cu thi xoa
        lastRow = .Cells(Rows.Count, "DD").End(xlUp).Row
        If lastRow > 1 Then .Range("DD2:DE" & lastRow).ClearContents
'        dong cuoi cung co du lieu o cot AG
        lastRow = .Cells(Rows.Count, "AG").End(xlUp).Row
'        khong co du lieu thi ket thuc
        If lastRow < 2 Then Exit Sub
    End With
    
    Set dic = CreateObject("Scripting.Dictionary")
    With dic
'        duyet tung dong cua mang data, them key va item. item la mang co 2 phan tu, tu cot B va cot I
        For i = 1 To UBound(data)
            If Not .exists(data(i, 1)) Then
                ReDim item(1 To 2)
'                tu cot B
                item(1) = data(i, 2)
'                tu cot I
                item(2) = data(i, 9)
'                them vao tu dien
                .Add data(i, 1), item
            End If
        Next
    End With
'    cho cac gia tri can tim tu cot AG cua sheet VNSO vao mang data. Lay du 1 dong
    data = ws.Range("AG2:AG" & lastRow + 1).Value
    ReDim result(1 To UBound(data) - 1, 1 To 2)
'    duyet mang data, khong xet dong cuoi cung lay them
    For i = 1 To UBound(data) - 1
        If dic.exists(data(i, 1)) Then
'            doc ra cot B va I tu tap tin Data.xlsm, da ghi trong item
            item = dic.item(data(i, 1))
'            ghi ket qua vao mang result
            result(i, 1) = item(1)
            result(i, 2) = item(2)
        End If
    Next
'    dap mang result xuong sheet
    ws.Range("DD2").Resize(UBound(result), 2).Value = result
    
    Set dic = Nothing
End Sub
 
Upvote 0
Biết ngay mà. Lại phải viết lần nữa.

̣Thôi, làm lần cuối. Tập tin Ecel và Word ở cùng thư mục. Để nguyên "all" và nhấn OK hoặc nhập vd. 2, 5, 8 (2,5,8) và nhấn OK. Code không kiểm tra lỗi nhập vd. 2.3, 5, 8 hoặc 1234 khi dữ liệu chỉ có tới dòng vd. 200
Mã:
Sub bbntcv()
Const wdReplaceAll = 2
    Dim indexs As String, dong, data()
    Dim num_of_column As Long
    Dim lastRow As Long, k As Long, i As Long, j As Long
    Dim template As Object, t As Object

    With Sheet6
        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
        If lastRow < 2 Then Exit Sub
    End With
    indexs = InputBox("Hay nhap cac chi so dong tren sheet hoac de nguyen ""all"" va nhan OK", "Nhap chi so dong", "all")
    If indexs = "" Then Exit Sub
   
    data = Sheet6.Range("A1:N" & lastRow).Value
   
    If indexs = "all" Then
        ReDim dong(0 To UBound(data) - 2)
        For k = 0 To UBound(dong)
            dong(k) = k + 2
        Next k
    Else
        dong = Split(Replace(indexs, " ", ""), ",")
    End If
   
    num_of_column = 14
   
    With CreateObject("word.application")
'        .Visible = True
        For i = 0 To UBound(dong)
            k = dong(i)
            Set template = .documents.Open(ThisWorkbook.Path & "\BBNTCV.doc")
            Set t = template.Content
            For j = 1 To num_of_column
                If j = 4 Or j = 5 Then
                    data(k, j) = Format(data(k, j), "HH:mm")
                ElseIf j = 9 Then
                    data(k, j) = Round(data(k, j), 3)
                End If
                t.Find.Execute findtext:=data(1, j), ReplaceWith:=data(k, j), Replace:=wdReplaceAll
            Next j
            With template
                .SaveAs Filename:=ThisWorkbook.Path & "\" & k & "-BBNTCV.doc"
                .Close
            End With
        Next i
        .Quit
    End With
    Set t = Nothing
    Set template = Nothing
   
End Sub
Tuyệt vời, mình rất rất cảm ơn bạn. Chúc bạn và gia đình luôn hạnh phúc! :)
 
Upvote 0
Web KT
Back
Top Bottom