Giúp hoàn thiện import dữ liệu từ nhiều files

[tranaidh]

Tôi có xem trên diễn đàn và tạo được file tổng hợp từ nhiều file. Nhưng còn rất thủ công. Mong mọi người giúp và hoàn thiện cho mình với a.
Mình muốn tổng hợp điểm từ các file nằm trong các thư mục các môn, Trong mỗi thư mục môn thì có các file được xếp tăng dần theo phòng thi. Mình muốn một nút lệnh có thể tự động import dữ liệu từ các thư mục theo thứ tự các file. Mong mọi người giúp đỡ ạ. Mình xin cảm ơn!

Bài đã được tự động gộp: 2/7/20

 

[giaiphap]

Tôi có xem trên diễn đàn và tạo được file tổng hợp từ nhiều file. Nhưng còn rất thủ công. Mong mọi người giúp và hoàn thiện cho mình với a.
Mình muốn tổng hợp điểm từ các file nằm trong các thư mục các môn, Trong mỗi thư mục môn thì có các file được xếp tăng dần theo phòng thi. Mình muốn một nút lệnh có thể tự động import dữ liệu từ các thư mục theo thứ tự các file. Mong mọi người giúp đỡ ạ. Mình xin cảm ơn!

Bài đã được tự động gộp: 2/7/20

Nhưng phải có file mới biết dữ liệu bố trí ra sao mới được chứ.

 

[tranaidh]

Nhưng phải có file mới biết dữ liệu bố trí ra sao mới được chứ.

Dạ file đính kèm phía trên đó ạ

Bài đã được tự động gộp: 3/7/20

 

[giaiphap]

Dạ file đính kèm phía trên đó ạ

Bài đã được tự động gộp: 3/7/20

Bạn xem dùng code sau:

Sub Main()
    Dim objFolder As Object, objSubFolder As Object, fso As Object, File
    Dim col As Integer, aRes, Target As Range
    Sheet1.UsedRange.Offset(2).ClearContents
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(ThisWorkbook.Path)
   
    For Each objSubFolder In objFolder.SubFolders
        Select Case fso.GetFolder(objSubFolder.Path).Name
            Case "TOAN":    col = 1
            Case "VAN":     col = 2
            Case "ANH":     col = 3
            Case "SU":      col = 4
            Case "DIA":     col = 5
            Case "GDCD":    col = 6
        End Select
        For Each File In objSubFolder.Files
              aRes = GetData(File, "Sheet1", "A5:C10000", False, False)
              If IsArray(aRes) Then
                Set Target = Sheet1.Range("A60000").Offset(, (col - 1) * 3).End(xlUp).Offset(1)
                Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
              End If
        Next
    Next objSubFolder
    Set Target = Nothing
    Set fso = Nothing
    MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub

Bạn tự kiểm tra kết quả nhé.

 

[tranaidh]

Bạn xem dùng code sau:

Sub Main()
    Dim objFolder As Object, objSubFolder As Object, fso As Object, File
    Dim col As Integer, aRes, Target As Range
    Sheet1.UsedRange.Offset(2).ClearContents
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set objFolder = fso.GetFolder(ThisWorkbook.Path)
  
    For Each objSubFolder In objFolder.SubFolders
        Select Case fso.GetFolder(objSubFolder.Path).Name
            Case "TOAN":    col = 1
            Case "VAN":     col = 2
            Case "ANH":     col = 3
            Case "SU":      col = 4
            Case "DIA":     col = 5
            Case "GDCD":    col = 6
        End Select
        For Each File In objSubFolder.Files
              aRes = GetData(File, "Sheet1", "A5:C10000", False, False)
              If IsArray(aRes) Then
                Set Target = Sheet1.Range("A60000").Offset(, (col - 1) * 3).End(xlUp).Offset(1)
                Target.Resize(UBound(aRes, 1) + 1, UBound(aRes, 2) + 1).Value = aRes
              End If
        Next
    Next objSubFolder
    Set Target = Nothing
    Set fso = Nothing
    MsgBox "Da thuc hien xong", vbExclamation, "---GPE---"
End Sub

Bạn tự kiểm tra kết quả nhé.

Cảm ơn bạn nhiều, đúng là cái mình rất cần