Copy dữ liệu vào nhiều file theo điều kiện

bigbabol89 · 19/11/19

Xin chào các anh chị,
Mong các anh chị giúp đỡ em vấn đề sau ạ.
Em có 1 file control trong đó chứa dữ liệu, em cần copy dữ liệu ở file control này vào nhiều file khác nhau theo điều kiện :
- Copy theo từng đường dẫn.
- Mỗi giá trị sau khi copy vào file nhỏ giãn cách nhau 5 dòng.
( Các file nhỏ đều có cấu trúc giống nhau )
Em mô tả chi tiết trong file đính kèm ạ.
Em cám ơn.

C:\Users\Administrator\Desktop\Test 1.xlsx	C:\Users\Administrator\Desktop\Test 2.xlsx	C:\Users\Administrator\Desktop\Test 3.xlsx
111	888	8787
222	999	8888
333	1212	8686
444	1313	8685
555	1414	8483
	1515	8281
	1616	9990
		9295
		9697

batman1 · 20/11/19

1. Thêm Module1.
Code cho Module1

Mã:

Sub saochep()
Dim lastRow As Long, lastCol As Long, k As Long, r As Long, filename As String, data(), sh As Worksheet, wb As Workbook
    Set sh = ThisWorkbook.Worksheets("Control")
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
'    duyet tung cot du lieu
    For k = 1 To lastCol
'        ten tap tin
        filename = sh.Cells(1, k).Value
'        neu ten tap tin khong rong thi thuc hien
        If filename <> "" Then
            lastRow = sh.Cells(Rows.Count, k).End(xlUp).Row
'            neu co du lieu thi thuc hien
            If lastRow > 1 Then
'                lay du lieu vao mang data. Mang data co so dong = 6*<so dong co du lieu tren sheet>
'                Hien thoi du lieu o (lastRow - 1) dong dau tien. dataith  vua la mang nguon vua la mang ket qua
                data = sh.Cells(2, k).Resize(6 * (lastRow - 1)).Value
'                ban tung du lieu vao vi tri dung cua no va xoa o vi tri cu. Du lieu 1 da dung vi tri
'                Phai duyet tu dong cuoi de khoi ghi de ket qua vao vi tri nguon
                For r = lastRow - 1 To 2 Step -1
                    data(1 + 6 * (r - 1), 1) = data(r, 1)
                    data(r, 1) = Empty
                Next r
'                mo tap tin
                On Error Resume Next
                Set wb = Workbooks.Open(filename)
                If Err.Number Then
'                    da co loi (tap tin khong ton tai). Xoa loi va khong lam gi
                    Err.Clear
                Else
                    With wb.Worksheets("Test")
'                        xoa ket qua cu
                        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                        If lastRow >= 6 Then .Range("B6:B" & lastRow).ClearContents
'                        nhap du lieu moi
                        .Range("B6").Resize(UBound(data)).Value = data
'                        luu va dong tap tin
                        Application.DisplayAlerts = False
                        wb.Close True
                        Application.DisplayAlerts = True
                    End With
                End If
                On Error GoTo 0
            End If
        End If
    Next k
End Sub

2. Nếu các tập tin Test được đặt cùng thư mục với tập tin Control thì:
- dòng 1 của Control chỉ ghi tên không có đường dẫn: Test1.xlsx, Test2.xlsx, ...
- sửa

Mã:

Set wb = Workbooks.Open(filename)

thành

Mã:

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & filename)

bigbabol89 · 20/11/19

batman1 đã viết:

1. Thêm Module1.
Code cho Module1

Mã:

Sub saochep()
Dim lastRow As Long, lastCol As Long, k As Long, r As Long, filename As String, data(), sh As Worksheet, wb As Workbook
    Set sh = ThisWorkbook.Worksheets("Control")
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
'    duyet tung cot du lieu
    For k = 1 To lastCol
'        ten tap tin
        filename = sh.Cells(1, k).Value
'        neu ten tap tin khong rong thi thuc hien
        If filename <> "" Then
            lastRow = sh.Cells(Rows.Count, k).End(xlUp).Row
'            neu co du lieu thi thuc hien
            If lastRow > 1 Then
'                lay du lieu vao mang data. Mang data co so dong = 6*<so dong co du lieu tren sheet>
'                Hien thoi du lieu o (lastRow - 1) dong dau tien. dataith  vua la mang nguon vua la mang ket qua
                data = sh.Cells(2, k).Resize(6 * (lastRow - 1)).Value
'                ban tung du lieu vao vi tri dung cua no va xoa o vi tri cu. Du lieu 1 da dung vi tri
'                Phai duyet tu dong cuoi de khoi ghi de ket qua vao vi tri nguon
                For r = lastRow - 1 To 2 Step -1
                    data(1 + 6 * (r - 1), 1) = data(r, 1)
                    data(r, 1) = Empty
                Next r
'                mo tap tin
                On Error Resume Next
                Set wb = Workbooks.Open(filename)
                If Err.Number Then
'                    da co loi (tap tin khong ton tai). Xoa loi va khong lam gi
                    Err.Clear
                Else
                    With wb.Worksheets("Test")
'                        xoa ket qua cu
                        lastRow = .Cells(Rows.Count, "B").End(xlUp).Row
                        If lastRow >= 6 Then .Range("B6:B" & lastRow).ClearContents
'                        nhap du lieu moi
                        .Range("B6").Resize(UBound(data)).Value = data
'                        luu va dong tap tin
                        Application.DisplayAlerts = False
                        wb.Close True
                        Application.DisplayAlerts = True
                    End With
                End If
                On Error GoTo 0
            End If
        End If
    Next k
End Sub

2. Nếu các tập tin Test được đặt cùng thư mục với tập tin Control thì:
- dòng 1 của Control chỉ ghi tên không có đường dẫn: Test1.xlsx, Test2.xlsx, ...
- sửa

Mã:

Set wb = Workbooks.Open(filename)

thành

Mã:

Set wb = Workbooks.Open(ThisWorkbook.Path & "\" & filename)

Code dùng tốt lắm anh ạ. Thích nhất khoản chú thích của anh

bigbabol89 · 21/11/19

Anh ơi, anh cho làm phiền anh thêm chút nữa. Anh có thể cho code : khi copy vào các file con thì chỉ copy những giá trị mới, những giá trị nào đã tồn tại ở file con thì bỏ qua ( giữ nguyên ). Những giá trị thêm mới vào sẽ lần lượt ở dưới ạ.
Em cám ơn

batman1 · 22/11/19

bigbabol89 đã viết:
Anh ơi, anh cho làm phiền anh thêm chút nữa. Anh có thể cho code : khi copy vào các file con thì chỉ copy những giá trị mới, những giá trị nào đã tồn tại ở file con thì bỏ qua ( giữ nguyên ). Những giá trị thêm mới vào sẽ lần lượt ở dưới ạ.
Em cám ơn

Bỏ qua hay không xóa cũ và copy dưới những giá trị tồn tại?

Tôi hiểu copy như sau:
a. Copy tiếp theo các dữ liệu đã có bất luận dữ liệu mới như thế nào.
Vd. trong tập tin đã tồn tại ở các dòng 6, 12, 18, 24, 30 các giá trị 111, 222, 333, 444, 555. Bây giờ có 3 giá trị 111, 987, 555 thì copy cả 3 giá trị đó vào các dòng 36, 42, 48.

b. Copy tiếp theo các dữ liệu đã có nhưng chỉ copy các giá trị chưa tồn tại trong tập tin.
Vd. trong tập tin đã tồn tại ở các dòng 6, 12, 18, 24, 30 các giá trị 111, 222, 333, 444, 555. Bây giờ có 3 giá trị 111, 987, 555 thì chỉ copy 1 giá trị 987 vào dòng 3.

Câu hỏi: bạn định nói tới trường hợp nào?

Hiện tại tôi làm cho trường hợp a. Nếu muốn trường hợp b thì kêu một tiếng tôi sẽ chỉnh.

Nếu nói tới trường hợp b thì cũng nói rõ là có dữ liệu text hay không. Nếu có dữ liệu text thì nói rõ có phân biệt chữ hoa hay thường không. Vd. tập tin đã có 12AB thì có copy thêm 12ab hay không.

Trường hợp a:
1. Xóa chú thích: ' xoa ket qua cu

2. Thay

Mã:

                        If lastRow >= 6 Then .Range("B6:B" & lastRow).ClearContents
'                        nhap du lieu moi
                        .Range("B6").Resize(UBound(data)).Value = data

bằng

Mã:

                        If lastRow < 6 Then lastRow = 0
                        .Range("B" & lastRow + 6).Resize(UBound(data)).Value = data

be_09 · 22/11/19

bigbabol89 đã viết:
Xin chào các anh chị,
Mong các anh chị giúp đỡ em vấn đề sau ạ.
Em có 1 file control trong đó chứa dữ liệu, em cần copy dữ liệu ở file control này vào nhiều file khác nhau theo điều kiện :
- Copy theo từng đường dẫn.
- Mỗi giá trị sau khi copy vào file nhỏ giãn cách nhau 5 dòng.
( Các file nhỏ đều có cấu trúc giống nhau )
Em mô tả chi tiết trong file đính kèm ạ.
Em cám ơn.

Không biết File bạn theo dõi có nhiều dữ liệu hay không? Theo tôi nghĩ nên theo dõi chung 1 sheet, trong đó có cột chứa nội dung cần tách File thì nó sẽ đơn giản hơn là lấy dữ liệu vào từng File có sẳn (dẫn đến dễ sai sót).

bigbabol89 · 22/11/19

batman1 đã viết:
Bỏ qua hay không xóa cũ và copy dưới những giá trị tồn tại?

Tôi hiểu copy như sau:
a. Copy tiếp theo các dữ liệu đã có bất luận dữ liệu mới như thế nào.
Vd. trong tập tin đã tồn tại ở các dòng 6, 12, 18, 24, 30 các giá trị 111, 222, 333, 444, 555. Bây giờ có 3 giá trị 111, 987, 555 thì copy cả 3 giá trị đó vào các dòng 36, 42, 48.

b. Copy tiếp theo các dữ liệu đã có nhưng chỉ copy các giá trị chưa tồn tại trong tập tin.
Vd. trong tập tin đã tồn tại ở các dòng 6, 12, 18, 24, 30 các giá trị 111, 222, 333, 444, 555. Bây giờ có 3 giá trị 111, 987, 555 thì chỉ copy 1 giá trị 987 vào dòng 3.

Câu hỏi: bạn định nói tới trường hợp nào?

Hiện tại tôi làm cho trường hợp a. Nếu muốn trường hợp b thì kêu một tiếng tôi sẽ chỉnh.

Nếu nói tới trường hợp b thì cũng nói rõ là có dữ liệu text hay không. Nếu có dữ liệu text thì nói rõ có phân biệt chữ hoa hay thường không. Vd. tập tin đã có 12AB thì có copy thêm 12ab hay không.

Trường hợp a:
1. Xóa chú thích: ' xoa ket qua cu

2. Thay

Mã:

If lastRow >= 6 Then .Range("B6:B" & lastRow).ClearContents ' nhap du lieu moi .Range("B6").Resize(UBound(data)).Value = data

bằng

Mã:

If lastRow < 6 Then lastRow = 0 .Range("B" & lastRow + 6).Resize(UBound(data)).Value = data

Dạ là ý b ạ.
Dữ liệu có dạng text, không phân biệt chữ hoa chữ thường.
Em mô tả trong file ạ. Em cám ơn anh

bigbabol89 · 22/11/19

be09 đã viết:
Không biết File bạn theo dõi có nhiều dữ liệu hay không? Theo tôi nghĩ nên theo dõi chung 1 sheet, trong đó có cột chứa nội dung cần tách File thì nó sẽ đơn giản hơn là lấy dữ liệu vào từng File có sẳn (dẫn đến dễ sai sót).

File của em không dùng để theo dõi mà để chia ra sau đó gửi người khác ạ

batman1 · 22/11/19

bigbabol89 đã viết:
Dạ là ý b ạ.
Dữ liệu có dạng text, không phân biệt chữ hoa chữ thường.
Em mô tả trong file ạ. Em cám ơn anh

Tóm lại là tập tin ngoài luôn chỉ có những giá trị duy nhất, không trùng lặp. Tức:

a. chỉ thêm các dữ liệu từ Control mà chưa có trong tập tin ngoài.

b. nếu dữ liệu thêm ở điểm a xuất hiện nhiều lần trong Control thì chỉ thêm 1 lần khi xuất hiện lần đầu tiên ở Control.

Điểm b tôi thêm vì bạn không mô tả dữ liệu của Control nên tôi không biết liệu dữ liệu ở Control có lặp lại hay luôn duy nhât. Thậm chí nếu theo lý thuyết chúng phải không trùng lặp thì do con người chỉ là con người và có thể nhầm lẫn nên code vẫn tự kiểm tra và chỉ thêm mỗi dữ liệu 1 lần duy nhất. Code thân thiện với người dùng mà

Mã:

Sub saochep()
Dim lastRow As Long, lastRow2 As Long, lastCol As Long, k As Long, r As Long, curr_row As Long, filename As String, data(), result(), sh As Worksheet, wb As Workbook
Dim dic As Object, fso As Object
    Set sh = ThisWorkbook.Worksheets("Control")
'    cot cuoi cung co du lieu o dong 1 trong sheet Control
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    Set dic = CreateObject("Scripting.Dictionary")
'    so sanh khong phan biet chu hoa chu thuong
    dic.comparemode = vbTextCompare
    Set fso = CreateObject("Scripting.FileSystemObject")
'    duyet tung cot du lieu
    For k = 1 To lastCol
'        ten tap tin
        filename = sh.Cells(1, k).Value
'        neu tap tin ngoai ton tai thi thuc hien
        If fso.FileExists(filename) Then
'            dong cuoi cung co du lieu trong cot hien hanh trong sheet Control
            lastRow = sh.Cells(Rows.Count, k).End(xlUp).Row
'            neu co du lieu thi thuc hien
            If lastRow > 1 Then
'                mo tap tin ngoai hien hanh de nhap du lieu tu cot du lieu hien hanh o sheet Control
                Set wb = Workbooks.Open(filename)
'                xoa cac du lieu co trong Tu Dien
                dic.RemoveAll
'                xet cot B cua sheet Test cua tap tin ngoai
                With wb.Worksheets("Test")
'                    dong cuoi cung co du lieu o cot B
                    lastRow2 = .Cells(Rows.Count, "B").End(xlUp).Row
                    If lastRow2 >= 6 Then
'                        da co du lieu cu. Lay du lieu cu vao mang data
                        data = .Range("B6:B" & lastRow2 + 1).Value
'                        duyet mang data va cho cac du lieu duy nhat vao Tu Dien
                        For r = 1 To UBound(data) - 1
'                            De phong co dong trong thi bo qua
                            If data(r, 1) <> "" Then dic.Add data(r, 1), ""
                        Next r
                    Else
'                        chua co du lieu cu
                        lastRow2 = 0
                    End If
                End With
'                lay du lieu tu cot hien hanh trong sheet Control vao mang data. Lay them 1 dong trong sau dong lastRow
                data = sh.Cells(2, k).Resize(lastRow).Value
'                dat bo nho cho mang ket qua result
                ReDim result(1 To 6 * (UBound(data) - 1), 1 To 1)
                curr_row = -5
'                duyet tung dong cua mang data, bo qua dong lay them o cuoi
                For r = 1 To UBound(data) - 1
'                    bo qua o trong neu co (phong xa)
                    If data(r, 1) <> "" Then
'                        neu chua co trong Tu Dien thi lay du lieu vao mang result va dong thoi them du lieu vao Tu Dien
                        If Not dic.exists(data(r, 1)) Then
                            curr_row = curr_row + 6
                            result(curr_row, 1) = data(r, 1)
'                            them du lieu vao Tu Dien de co the phat hien truong hop du lieu hien hanh co trung lap
                            dic.Add data(r, 1), ""
                        End If
                    End If
                Next r
'                neu co ket qua hien hanh thi nhap ket qua vao tap tin ngoai hien hanh
                If curr_row > 0 Then wb.Worksheets("Test").Range("B" & lastRow2 + 6).Resize(curr_row).Value = result
                Application.DisplayAlerts = False
'                dong tap tin ngoai
                wb.Close True
                Application.DisplayAlerts = True
            End If
        End If
    Next k
    Set dic = Nothing
    Set fso = Nothing
End Sub

bigbabol89 · 22/11/19

batman1 đã viết:

Tóm lại là tập tin ngoài luôn chỉ có những giá trị duy nhất, không trùng lặp. Tức:

a. chỉ thêm các dữ liệu từ Control mà chưa có trong tập tin ngoài.

b. nếu dữ liệu thêm ở điểm a xuất hiện nhiều lần trong Control thì chỉ thêm 1 lần khi xuất hiện lần đầu tiên ở Control.

Điểm b tôi thêm vì bạn không mô tả dữ liệu của Control nên tôi không biết liệu dữ liệu ở Control có lặp lại hay luôn duy nhât. Thậm chí nếu theo lý thuyết chúng phải không trùng lặp thì do con người chỉ là con người và có thể nhầm lẫn nên code vẫn tự kiểm tra và chỉ thêm mỗi dữ liệu 1 lần duy nhất. Code thân thiện với người dùng mà

Mã:

Sub saochep()
Dim lastRow As Long, lastRow2 As Long, lastCol As Long, k As Long, r As Long, curr_row As Long, filename As String, data(), result(), sh As Worksheet, wb As Workbook
Dim dic As Object, fso As Object
    Set sh = ThisWorkbook.Worksheets("Control")
'    cot cuoi cung co du lieu o dong 1 trong sheet Control
    lastCol = sh.Cells(1, Columns.Count).End(xlToLeft).Column
    Set dic = CreateObject("Scripting.Dictionary")
'    so sanh khong phan biet chu hoa chu thuong
    dic.comparemode = vbTextCompare
    Set fso = CreateObject("Scripting.FileSystemObject")
'    duyet tung cot du lieu
    For k = 1 To lastCol
'        ten tap tin
        filename = sh.Cells(1, k).Value
'        neu tap tin ngoai ton tai thi thuc hien
        If fso.FileExists(filename) Then
'            dong cuoi cung co du lieu trong cot hien hanh trong sheet Control
            lastRow = sh.Cells(Rows.Count, k).End(xlUp).Row
'            neu co du lieu thi thuc hien
            If lastRow > 1 Then
'                mo tap tin ngoai hien hanh de nhap du lieu tu cot du lieu hien hanh o sheet Control
                Set wb = Workbooks.Open(filename)
'                xoa cac du lieu co trong Tu Dien
                dic.RemoveAll
'                xet cot B cua sheet Test cua tap tin ngoai
                With wb.Worksheets("Test")
'                    dong cuoi cung co du lieu o cot B
                    lastRow2 = .Cells(Rows.Count, "B").End(xlUp).Row
                    If lastRow2 >= 6 Then
'                        da co du lieu cu. Lay du lieu cu vao mang data
                        data = .Range("B6:B" & lastRow2 + 1).Value
'                        duyet mang data va cho cac du lieu duy nhat vao Tu Dien
                        For r = 1 To UBound(data) - 1
'                            De phong co dong trong thi bo qua
                            If data(r, 1) <> "" Then dic.Add data(r, 1), ""
                        Next r
                    Else
'                        chua co du lieu cu
                        lastRow2 = 0
                    End If
                End With
'                lay du lieu tu cot hien hanh trong sheet Control vao mang data. Lay them 1 dong trong sau dong lastRow
                data = sh.Cells(2, k).Resize(lastRow).Value
'                dat bo nho cho mang ket qua result
                ReDim result(1 To 6 * (UBound(data) - 1), 1 To 1)
                curr_row = -5
'                duyet tung dong cua mang data, bo qua dong lay them o cuoi
                For r = 1 To UBound(data) - 1
'                    bo qua o trong neu co (phong xa)
                    If data(r, 1) <> "" Then
'                        neu chua co trong Tu Dien thi lay du lieu vao mang result va dong thoi them du lieu vao Tu Dien
                        If Not dic.exists(data(r, 1)) Then
                            curr_row = curr_row + 6
                            result(curr_row, 1) = data(r, 1)
'                            them du lieu vao Tu Dien de co the phat hien truong hop du lieu hien hanh co trung lap
                            dic.Add data(r, 1), ""
                        End If
                    End If
                Next r
'                neu co ket qua hien hanh thi nhap ket qua vao tap tin ngoai hien hanh
                If curr_row > 0 Then wb.Worksheets("Test").Range("B" & lastRow2 + 6).Resize(curr_row).Value = result
                Application.DisplayAlerts = False
'                dong tap tin ngoai
                wb.Close True
                Application.DisplayAlerts = True
            End If
        End If
    Next k
    Set dic = Nothing
    Set fso = Nothing
End Sub

Ý b anh nói quả thực rất hữu dụng đối với file của em, em toàn phải xử lý tay trước khi làm

Tuy nhiên,, khi em thử thì nó bị thế này ạ

và ấn Debug thì lỗi ở đoạn :

Mã:

 If data(r, 1) <> "" Then dic.Add data(r, 1), ""

Anh xem giúp em với

batman1 · 23/11/19

bigbabol89 đã viết:
Ý b anh nói quả thực rất hữu dụng đối với file của em, em toàn phải xử lý tay trước khi làm
Tuy nhiên,, khi em thử thì nó bị thế này ạ

View attachment 228863
và ấn Debug thì lỗi ở đoạn :

Mã:

If data(r, 1) <> "" Then dic.Add data(r, 1), ""

Anh xem giúp em với

Đoạn code bạn trích có lỗi khi tập tin ngoài từ B6 trở xuống có dữ liệu trùng. Mà theo như bạn viết thì không bao giờ tập tin ngoài có quyền có dữ liệu trùng. Vì ở thời điểm 0 thì từ B6 trở xuống không có dữ liệu nên không có dữ liệu trùng. Sau đó cứ mỗi lần chạy code thì code chỉ thêm những dữ liệu chưa có trong tập tin ngoài. Tức ở mỗi thời điểm thì tập tin ngoài chỉ có những dữ liệu duy nhất. Bạn bị lỗi do khi bạn test thì tập tin ngoài đã có dữ liệu trùng, tức tập tin chứa dữ liệu không hợp lệ. Khi test mà bạn thấy có lỗi ở dòng bạn trích thì: nhấn End -> quay ra kiểm tra sheet Test của tập tin ngoài đang mở. Chắc chắn bạn sẽ thấy nó chứa dữ liệu trùng nào đó.

Sửa code để không có lỗi thì quá dễ. Chỉ cần sửa

Mã:

If data(r, 1) <> "" Then dic.Add data(r, 1), ""

thành

Mã:

If data(r, 1) <> "" And Not dic.exists(data(r, 1)) Then dic.Add data(r, 1), ""

Nhưng lúc đó nếu vì một lý do nào đó mà tập tin ngoài có dữ liệu trùng (cô bạn "ngồi cùng bàn" chơi khăm và thêm dữ liệu trùng) thì bạn không thấy có lỗi, và bạn không ý thức được là tập tin ngoài có dữ liệu không hợp lệ. Vì thế tôi viết code như đã viết để khi có dữ liệu không hợp lệ thì bạn ý thức được, biết được. Lỗi ở đây là lời cảnh báo rằng tập tin ngoài có vấn đề. Không có cảnh báo thì bạn sẽ rung đùi và nghĩ rằng dữ liệu của bạn là chuẩn.

Nếu muốn test thì trước hết bạn phải xóa hết các dữ liệu từ B6 trở xuống. Sau đó thì nhập dữ liệu trong Control nhiều lần, mỗi lần nhập xong thì nhấn Button. Hoặc nếu tập tin ngoài đã có nhiều dữ liệu thì bạn phải xóa những dữ liệu trùng nếu có trước khi test. Có thể làm như sau: Mở tập tin ngoài, vd. Test 1. xlsx -> dùng chức năng Data /Remove Duplicates để loại trùng -> lưu lại tập tin Test 1.xlsx -> đóng Test 1.xlsx. Bây giờ mới test.

bigbabol89 · 23/11/19

batman1 đã viết:
Đoạn code bạn trích có lỗi khi tập tin ngoài từ B6 trở xuống có dữ liệu trùng. Mà theo như bạn viết thì không bao giờ tập tin ngoài có quyền có dữ liệu trùng. Vì ở thời điểm 0 thì từ B6 trở xuống không có dữ liệu nên không có dữ liệu trùng. Sau đó cứ mỗi lần chạy code thì code chỉ thêm những dữ liệu chưa có trong tập tin ngoài. Tức ở mỗi thời điểm thì tập tin ngoài chỉ có những dữ liệu duy nhất. Bạn bị lỗi do khi bạn test thì tập tin ngoài đã có dữ liệu trùng, tức tập tin chứa dữ liệu không hợp lệ. Khi test mà bạn thấy có lỗi ở dòng bạn trích thì: nhấn End -> quay ra kiểm tra sheet Test của tập tin ngoài đang mở. Chắc chắn bạn sẽ thấy nó chứa dữ liệu trùng nào đó.

Sửa code để không có lỗi thì quá dễ. Chỉ cần sửa

Mã:

If data(r, 1) <> "" Then dic.Add data(r, 1), ""

thành

Mã:

If data(r, 1) <> "" And Not dic.exists(data(r, 1)) Then dic.Add data(r, 1), ""

Nhưng lúc đó nếu vì một lý do nào đó mà tập tin ngoài có dữ liệu trùng (cô bạn "ngồi cùng bàn" chơi khăm và thêm dữ liệu trùng) thì bạn không thấy có lỗi, và bạn không ý thức được là tập tin ngoài có dữ liệu không hợp lệ. Vì thế tôi viết code như đã viết để khi có dữ liệu không hợp lệ thì bạn ý thức được, biết được. Lỗi ở đây là lời cảnh báo rằng tập tin ngoài có vấn đề. Không có cảnh báo thì bạn sẽ rung đùi và nghĩ rằng dữ liệu của bạn là chuẩn.

Nếu muốn test thì trước hết bạn phải xóa hết các dữ liệu từ B6 trở xuống. Sau đó thì nhập dữ liệu trong Control nhiều lần, mỗi lần nhập xong thì nhấn Button. Hoặc nếu tập tin ngoài đã có nhiều dữ liệu thì bạn phải xóa những dữ liệu trùng nếu có trước khi test. Có thể làm như sau: Mở tập tin ngoài, vd. Test 1. xlsx -> dùng chức năng Data /Remove Duplicates để loại trùng -> lưu lại tập tin Test 1.xlsx -> đóng Test 1.xlsx. Bây giờ mới test.

Thì ra là vậy, em sẽ để như cũ để kiểm tra lỗi luôn.
Thực sự em không biết nói gì hơn, cám ơn anh rất rất nhiều. Không những giúp đỡ em viết code mà còn rất nhiệt tình nữa.

Copy dữ liệu vào nhiều file theo điều kiện

bigbabol89

Thành viên thường trực

File đính kèm

batman1

Thành viên gạo cội

bigbabol89

Thành viên thường trực

bigbabol89

Thành viên thường trực

batman1

Thành viên gạo cội

be_09

Biên Hòa, Đồng Nai

bigbabol89

Thành viên thường trực

File đính kèm

bigbabol89

Thành viên thường trực

batman1

Thành viên gạo cội

bigbabol89

Thành viên thường trực

batman1

Thành viên gạo cội

bigbabol89

Thành viên thường trực

Bài viết mới nhất

Facebook

Group

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