[Giúp đỡ] Việc copy dữ liệu từ bảng tính này sang bảng tính khác không cần mở File (2 người xem)

[vsxmm]

Chào tất cả anh chị em trong diễn đàn. Mình nhờ a/c/e trong điễn đàn giúp mình với. Vì lấy dữ liệu điểm nhiều quá nên mình sợ sai nên muốn có 1 code để tự động bớt và an toàn hơn. Rất mong được anh, chị, em giúp đỡ với.
Dưới đây là tình huống mà mình muốn giải quyết giúp.

----------------------------------------------------------------------------
File dữ liệu của ba khối (mỗi khối kiểm tra 2 lần) được đặt vào thư mục Dulieu.
File kết quả sau khi tổng hợp 2 lần kiểm tra được đặt trong thư mục KetQua
Cả file dulieu ban đầu và file kết quả đều được lưu theo khối. Mỗi file là toàn bộ khối đó.

Code được đặt trong file File_ChuyenDulieu.xlsm. Mỗi lần chạy code (trong file này) thì:
Trong sheet TongHopDiem ta sẽ tiến hành:
+ Chọn Khối lớp tại ô F1 và chọn lớp tại I1.
+ Chạy code. Code làm những việc sau:
· Kiểm tra danh sách ở hai lần kiểm tra. Nếu sai danh sách thì dừng lại và thông báo kiểm tra lại danh sách hai lần kiểm tra vì không trùng nhau. Nếu đúng thì tiếp tục.
· Copy dữ liệu tương ứng vào File_ChuyenDulieu.xlsm.
. Copy dữ liệu vào file ở thư mục kết quả để lưu dữ liệu (Ví dụ: Copy dữ liệu hai lần kiểm tra của khối 10 vào file Khoi10.xls ở thư mục KetQua).
· Có một thông báo là đã thực hiện xong thành công.
Có 1 yêu cầu nữa là nếu học sinh nào không có điểm (ô không có dữ liệu) thì để trống ô đó.
--------------------------------------------------------------------------------
Xin chân thành cảm ơn đã quan tâm và giúp đỡ nhiệt tình của các bạn!

 

[giaiphap]

File dữ liệu của ba khối (mỗi khối kiểm tra 2 lần) được đặt vào thư mục Dulieu.
File kết quả sau khi tổng hợp 2 lần kiểm tra được đặt trong thư mục KetQua

Chào tất cả anh chị em trong diễn đàn. Mình nhờ a/c/e trong điễn đàn giúp mình với. Vì lấy dữ liệu điểm nhiều quá nên mình sợ sai nên muốn có 1 code để tự động bớt và an toàn hơn. Rát mong được anh, chị, em giúp đỡ với.
Dưới đây là tình huống mà mình muốn giải quyết giúp.

----------------------------------------------------------------------------
Cả file dulieu ban đầu và file kết quả đều được lưu theo khối. Mỗi file là toàn bộ khối đó.

Code được đặt trong file File_ChuyenDulieu.xlsm. Mỗi lần chạy code (trong file này) thì:
Trong sheet TongHopDiem ta sẽ tiến hành:
+ Chọn Khối lớp tại ô F1 và chọn lớp tại I1.
+ Chạy code. Code làm những việc sau:
· Kiểm tra danh sách ở hai lần kiểm tra. Nếu sai danh sách thì dừng lại và thông báo kiểm tra lại danh sách hai lần kiểm tra vì không trùng nhau. Nếu đúng thì tiếp tục.
· Copy dữ liệu tương ứng vào File_ChuyenDulieu.xlsm.
. Copy dữ liệu vào file ở thư mục kết quả để lưu dữ liệu (Ví dụ: Copy dữ liệu hai lần kiểm tra của khối 10 vào file Khoi10.xls ở thư mục KetQua).
· Có một thông báo là đã thực hiện xong thành công.
--------------------------------------------------------------------------------
Xin chân thành cảm ơn đã quan tâm và giúp đỡ nhiệt tình của các bạn!

Bạn hỏi mà không đưa file mẫu lên đây chắc chẳng có ai giúp đâu.

 

[vsxmm]

Có mà bạn. Mình gởi lại đây bạn.

 

[giaiphap]

Có mà bạn. Mình gởi lại đây bạn.

Bác đưa file mà trống trơn không có một chút dữ liệu nào làm sao test được. Gửi lại file có dữ liệu đi bạn, và nên có một file mẫu càng tốt.

 

[vsxmm]

vì đây là dữ liệu điểm của học sinh khá nhạy cảm của nhà trường bạn ạ. Thầy Hiệu trưởng không cho tiết lộ điểm của học sinh ra ngoài. chỉ từng phụ huynh học sinh mới được phép biết con mình thôi bạn. Mình có thể làm dữ liệu giả được không bạn?
File mình gởi cũng là file mẫu luôn đó bạn. chỉ có điều không có dữ liệu của học sinh thôi

 

[giaiphap]

vì đây là dữ liệu điểm của học sinh khá nhạy cảm của nhà trường bạn ạ. Thầy Hiệu trưởng không cho tiết lộ điểm của học sinh ra ngoài. chỉ từng phụ huynh học sinh mới được phép biết con mình thôi bạn. Mình có thể làm dữ liệu giả được không bạn?
File mình gởi cũng là file mẫu luôn đó bạn. chỉ có điều không có dữ liệu của học sinh thôi

Tôi đâu bắt bạn đưa dữ liệu thật của trường, có thể bịa ra (nhưng bịa cũng phải cho hợp lý, dễ kiểm tra tính đúng sai), còn điểm số dùng hàm Rand để tạo cũng được mà. Nhưng ít ra phải có dữ liệu mới test được chứ bạn, chẳng lẽ tôi lại làm giúp bạn việc nhập cả vài chục lớp, mỗi lớp vài chục tên, mỗi tên vài chục điểm ... Vậy tôi chạy sớm.

 

[vsxmm]

Xin lỗi anh, chị, em nhé. Mình làm có dữ liệu lại rồi. Quy cách đặt là có tên lớp, Số Thứ tự.
Khối dữ liệu dùng để kiểm tra là khối 12. mấy ô mình tô màu vàng. Lớp C1, C2 nơi tô màu vàng là kiểm tra xem 0 điểm và không có dự thi copy sang có đúng như vậy không. Lớp C3 là tên học sinh bị sai danh sách. Một lần nữa xin lỗi các anh, chị, em và các bạn nhiều.
mình xin gởi lại file có dữ liệu

 

[giaiphap]

Xin lỗi anh, chị, em nhé. Mình làm có dữ liệu lại rồi. Quy cách đặt là có tên lớp, Số Thứ tự.
Khối dữ liệu dùng để kiểm tra là khối 12. mấy ô mình tô màu vàng. Lớp C1, C2 nơi tô màu vàng là kiểm tra xem 0 điểm và không có dự thi copy sang có đúng như vậy không. Lớp C3 là tên học sinh bị sai danh sách. Một lần nữa xin lỗi các anh, chị, em và các bạn nhiều.
mình xin gởi lại file có dữ liệu

Có gì chưa rõ góp ý để hoàn thiện.

 

[vsxmm]

Có gì chưa rõ góp ý để hoàn thiện.

Bạn giải thích giúpmáy tham số của hàm getData của bạn với. Bạn viết mình một hàm nhưng do mình không hiểu dùng sao hết. Với có thể bạn viết giúp mình một code nữa chạy với. Khi ở File_Chuyendulieu mà chạy thì nó lấy dữ liệu vào file đó cũng được. Phần còn lại mình copy tay vào file ở thư mục kết quả cũng được.

 

[giaiphap]

Bạn giải thích giúpmáy tham số của hàm getData của bạn với. Bạn viết mình một hàm nhưng do mình không hiểu dùng sao hết. Với có thể bạn viết giúp mình một code nữa chạy với. Khi ở File_Chuyendulieu mà chạy thì nó lấy dữ liệu vào file đó cũng được. Phần còn lại mình copy tay vào file ở thư mục kết quả cũng được.

Hàm GetData bạn tham khảo ở đây.
http://www.giaiphapexcel.com/forum/...ng-Macro-4-để-lấy-dữ-liệu-từ-1-file-đang-đóng
Còn việc tạo nút gì đó trong code ở #8 có sẳn rồi bạn, bạn lấy đoạn cuối ghi dữ liệu vào file.

    Range("B5:P54").ClearContents
    Range("B5:P5").Resize(UBound(dArr, 1)) = sArr

 

[vsxmm]

vì mình không biết gì về mấy thứ này cả bạn. làm và gặp tình huống như vậy thôi. nếu có thể bạn giúp mình được không. Do cũng gấp nữa nên mình đành làm vậy cho kịp thôi. cái nào đỡ khổi làm tay đỡ cái đó trước đã. qua đợt này chắc phải học hỏi cái này thôi. Mình chỉ là dân nghiệp dư mấy.

 

[vsxmm]

Bạn không cần phải tạo ra sheet Khối trong folder kết quả, mà hãy để code làm việc và tự tạo cho bạn. Cách làm như sau:
======================================
1. Sửa lại danh sách có tên khối ở Sheet1 (sheet dùng làm danh sách khối & lớp của bạn.) thành như sau, vùng range C6:C8 lần lượt là 10, 11, 12

Mục đích để làm danh sách khối khi chạy code

2. Copy code sau vào file: File_ChuyenDuLieu.xlsm và chạy code thì sẽ tự động dò tìm và tạo ra trong folder kết quả của bạn 3 file tương ứng 3 khối, trong mỗi file có các sheet là các lớp tương ứng...

Code lấy sheet mẫu là sheet "TongHopDiem" trên file để làm sheet mẫu khi copy.

P/s: chú ý là ở folder dữ liệu bạn phải bổ sung cho đầy đủ 6 file của 3 khối (lần 1 và lần 2) trước khi chạy code... Lưu ý là trong file fải có Tên sheet theo danh sách tên sheet ở trên nha, nếu thiếu thì code sẽ thông báo và ngừng xét...

Option Explicit
Public Sub GPE()
Dim Arr01, Arr02, WbMain As Workbook, Path As String, sMau As Worksheet
Dim N As Long, Z As Long, I As Long, J As Long, K As Long, dArr, tArr
Dim Wb As Workbook, Sh As Worksheet, nF01 As String, nF02 As String
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
Set WbMain = ThisWorkbook
Path = ThisWorkbook.Path
Set sMau = WbMain.Sheets("TongHopDiem")
tArr = Sheet2.Range("C6").Resize(3, 12).Value
On Error Resume Next
For N = 1 To UBound(tArr)
sMau.Copy
    For Z = 2 To UBound(tArr, 2)
        nF01 = Path & "\DuLieu\Khoi" & tArr(N, 1) & "_Lan1.xls"
        Set Wb = Workbooks.Open(nF01, True, True)
        Set Sh = Wb.Sheets(tArr(N, Z))
        Arr01 = Sh.Range("C10", Sh.Range("C65000").End(3)).Resize(, 8).Value
        Wb.Close False
        Set Wb = Nothing
        
        nF02 = Path & "\DuLieu\Khoi" & tArr(N, 1) & "_Lan2.xls"
        Set Wb = Workbooks.Open(nF02, True, True)
        Set Sh = Wb.Sheets(tArr(N, Z))
        Arr02 = Sh.Range("C10", Sh.Range("C65000").End(3)).Resize(, 8).Value
        Wb.Close False
        Set Wb = Nothing
        
        ReDim dArr(1 To UBound(Arr01), 1 To 15)
        
        ActiveSheet.Copy After:=Sheets(Sheets.Count)
        With ActiveSheet
            .Name = tArr(N, Z)
            .Range("F1").Value = tArr(N, 1): .Range("I1").Value = tArr(N, Z)
            
            If UBound(Arr01, 1) <> UBound(Arr02, 1) Then
               MsgBox "Du lieu khong khop giua lan 1 va lan 2 hoac File du lieu chua chuan"
               Exit Sub
            End If
            
            K = 0
                For I = 1 To UBound(Arr01, 1)
                    If Arr01(I, 1) <> Arr02(I, 1) Then
                        MsgBox "Du lieu khong khop giua lan 1 va lan 2 tai dong " & I
                        Exit Sub
                    Else
                        K = K + 1
                        dArr(K, 1) = K
                        dArr(K, 2) = Arr01(I, 1)
                        dArr(K, 3) = Arr01(I, 2)
                        For J = 3 To UBound(Arr01, 2)
                            dArr(K, (J - 1) * 2) = Arr01(I, J)
                            dArr(K, (J - 1) * 2 + 1) = Arr02(I, J)
                        Next J
                    End If
                Next I
            .Range("A5:P54").ClearContents
            .Range("A5").Resize(K, 15).Value = dArr
        End With
        Sheets(1).Activate
    Next Z
        Sheets(1).Delete
        ActiveWorkbook.Close True, Path & "\KetQua\Khoi" & tArr(N, 1) & ".xlsx"
Next N
MsgBox "Da Tach Xong!"
Application.DisplayAlerts = True
Application.AskToUpdateLinks = True
Application.ScreenUpdating = True
End Sub

chỉ có một câu thôi bạn. Cảm ơn bạn rất nhiều!

 

[vsxmm]

Vì khi mình tải xuống lúc đó mình không thấy pahr hồi bên dưới. sau một hồi lay hoay mình chạy được rồi. mình gởi lời cảm ơn.