Tổng hợi dữ liệu từ nhiều file Excel (1 người xem)

baquang1984 · 13/8/17

Em chào Thầy cô và các anh chị trên diễn đàn GPE!
Em có nhiều file Excel có cùng cấu trúc bố trí dữ liệu nên đưa lên đây nhờ các thầy cô và anh chị trên diễn đàn viết giúp em code VBA để tổng hợp được dữ liệu từ nhiều file này nếu không làm thủ công bằng tay thì lâu quá.
Yêu cầu của Chương trình như sau ạ
Em có nhiều file Excel có cùng cấu trúc dữ liệu muốn tổng hợp vào theo thứ tự cột như bảng ví dụ (Đó là kết quả muốn có ạ) Sheet lấy dữ liệu là Sheets"SoDiaChinh" của các file con
Trong file con được bố trí thành nhiều trang dữ liệu mỗi trang bố trí 54 dòng, khi tổng hợp dữ liệu thì dữ liệu cần tổng hợp vào biểu được lấy ở 2 Mục: I- NGƯỜI SỬ DỤNG ĐẤT và II - THỬA ĐẤT
Khi click vào Buttom Tổng Hợp chương trình sẽ hiện thông báo cho chọn đường dẫn đến file cần tổng hợp sau đó ta chọn các file con, chương trình sẽ thực hiện lệnh tổng hợp theo thứ tự như sau:
Thông tin CQL1 bao gồm các cột A, B, C, D, E, F ở mục: I- NGƯỜI SỬ DỤNG ĐẤT là dòng số 1 và 2
Thông tin CQL2 bao gồm các cột G, H, I, J, K, L, M ở mục: I- NGƯỜI SỬ DỤNG ĐẤT là dòng số 3 và 4
Khi chương trình lấy dữ liệu để điền thông tin cho CQL 1 sẽ tách dữ liệu ở Dòng số 1 mỗi trang trong file con theo điều kiện tách là dấu ',' và điền theo thứ tự các cột A, B, C, D, E
Cột F thì dữ liệu được lấy như sau nếu thông tin ở hàng CQL1 là Hộ ông: thì Cột F ghi là 1 nếu là Hộ bà: thì ghi là 2 nếu không có thì thôi để trống
Khi chương trình lấy dữ liệu để điền thông tin cho CQL 2 sẽ tách dữ liệu ở Dòng số 1 mỗi trang trong file con theo điều kiện tách là dấu ',' và điền theo thứ tự các cột G, H, I, J, K
Cột L thì dữ liệu được lấy như sau nếu thông tin ở hàng CQL2 là Ông: thì Cột L ghi là 1 nếu là Bà: thì ghi là 2 nếu không có thì thôi để trống
Chú ý: Tất cả các thửa đất đều phải có thông tin chủ quản lý
Các cột M, N, O, P, R, S, T, U, V lấy dữ liệu theo thứ tự cột ở mục II. THỬA ĐẤT theo thứ tự các cột như sau 1, 2, 3, 6, 7, 8, 9, 10
Cột Q lấy dữ liệu ở mục II. THỬA ĐẤT theo cột 4
Em cảm ơn Thầy cô và các anh chị trên diễn đàn nhiều

baquang1984 · 14/8/17

baquang1984 đã viết:
Em chào Thầy cô và các anh chị trên diễn đàn GPE!
Em có nhiều file Excel có cùng cấu trúc bố trí dữ liệu nên đưa lên đây nhờ các thầy cô và anh chị trên diễn đàn viết giúp em code VBA để tổng hợp được dữ liệu từ nhiều file này nếu không làm thủ công bằng tay thì lâu quá.
Yêu cầu của Chương trình như sau ạ
Em có nhiều file Excel có cùng cấu trúc dữ liệu muốn tổng hợp vào theo thứ tự cột như bảng ví dụ (Đó là kết quả muốn có ạ) Sheet lấy dữ liệu là Sheets"SoDiaChinh" của các file con
Trong file con được bố trí thành nhiều trang dữ liệu mỗi trang bố trí 54 dòng, khi tổng hợp dữ liệu thì dữ liệu cần tổng hợp vào biểu được lấy ở 2 Mục: I- NGƯỜI SỬ DỤNG ĐẤT và II - THỬA ĐẤT
Khi click vào Buttom Tổng Hợp chương trình sẽ hiện thông báo cho chọn đường dẫn đến file cần tổng hợp sau đó ta chọn các file con, chương trình sẽ thực hiện lệnh tổng hợp theo thứ tự như sau:
Thông tin CQL1 bao gồm các cột A, B, C, D, E, F ở mục: I- NGƯỜI SỬ DỤNG ĐẤT là dòng số 1 và 2
Thông tin CQL2 bao gồm các cột G, H, I, J, K, L, M ở mục: I- NGƯỜI SỬ DỤNG ĐẤT là dòng số 3 và 4
Khi chương trình lấy dữ liệu để điền thông tin cho CQL 1 sẽ tách dữ liệu ở Dòng số 1 mỗi trang trong file con theo điều kiện tách là dấu ',' và điền theo thứ tự các cột A, B, C, D, E
Cột F thì dữ liệu được lấy như sau nếu thông tin ở hàng CQL1 là Hộ ông: thì Cột F ghi là 1 nếu là Hộ bà: thì ghi là 2 nếu không có thì thôi để trống
Khi chương trình lấy dữ liệu để điền thông tin cho CQL 2 sẽ tách dữ liệu ở Dòng số 1 mỗi trang trong file con theo điều kiện tách là dấu ',' và điền theo thứ tự các cột G, H, I, J, K
Cột L thì dữ liệu được lấy như sau nếu thông tin ở hàng CQL2 là Ông: thì Cột L ghi là 1 nếu là Bà: thì ghi là 2 nếu không có thì thôi để trống
Chú ý: Tất cả các thửa đất đều phải có thông tin chủ quản lý
Các cột M, N, O, P, R, S, T, U, V lấy dữ liệu theo thứ tự cột ở mục II. THỬA ĐẤT theo thứ tự các cột như sau 1, 2, 3, 6, 7, 8, 9, 10
Cột Q lấy dữ liệu ở mục II. THỬA ĐẤT theo cột 4
Em cảm ơn Thầy cô và các anh chị trên diễn đàn nhiều

Không biết bài của em đăng lên diễn đàn thầy cô và anh chị xem có gì em giải thích yêu cầu của chương trình chưa được các thành viên cho ý kiến ạ. Em mong được sự giúp đỡ của các thành viên trên diễn đàn ạ
Em cảm ơn nhiều

baquang1984 · 15/8/17

Có ai giúp em chương trình này với ạ

baquang1984 · 17/8/17

Em mong được sự hỗ trợ về chương trình này của thầy cô và anh chị trên diễn đàn ạ, không thấy có phản hồi gì về bài này của em không biết em có giải thích sai hay không đầy đủ thông tin ạ. Mong được giúp đỡ em cảm ơn nhiều ạ

baquang1984 · 21/8/17

hpkhuong đã viết:

Tự Test lại nhé

Mã:

Public Sub GPE()
Dim Wb As Workbook, sArr, dArr(1 To 50000, 1 To 22), I As Long, R As Long, K As Long
Dim J As Long, lR As Long, Rng As Range, Item, Ws As Worksheet, Tmp, Tmp2, Tmp3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Microsoft Excel Files", "*.xls*", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
On Error Resume Next
For Each Item In .SelectedItems
Set Wb = Workbooks.Open(Item)
Set Ws = Wb.Sheets("SoDiaChinh")
sArr = Ws.Range("A1", Ws.Range("A65000").End(3)).Resize(, 10).Value
    For I = 1 To UBound(sArr) Step 55
        If Len(sArr(I + 2, 1)) Then
            For R = 1 To 17
                If Len(sArr(I + R + 9, 1)) Then
                    K = K + 1
                    Tmp = Split(sArr(I + 2, 1), ",")
                    If Left(Tmp(0), 6) = "Hé «ng" Then
                        dArr(K, 6) = 1: dArr(K, 12) = 2
                    Else
                        dArr(K, 6) = 2: dArr(K, 12) = 1
                    End If
                    For J = 0 To UBound(Tmp)
                        dArr(K, J + 1) = Trim(Mid(Tmp(J), InStr(1, Tmp(J), ": ") + 2, Len(Tmp(J))))
                    Next
                    Tmp2 = Split(sArr(I + 4, 1), ",")
                  
                    For J = 0 To UBound(Tmp2)
                        dArr(K, J + 7) = Trim(Mid(Tmp2(J), InStr(1, Tmp2(J), ": ") + 2, Len(Tmp2(J))))
                    Next
                  
                    dArr(K, 13) = Mid(sArr(I + 3, 1), 10, Len(sArr(I + 3, 1)))
                    For J = 1 To 4
                        dArr(K, J + 13) = sArr(I + R + 9, J)
                    Next
                    For J = 6 To 10
                        dArr(K, J + 12) = sArr(I + R + 9, J)
                    Next
                End If
            Next
        End If
    Next
    Wb.Close
Next
End With
If K Then
    Range("A4", Range("A65000").End(3)).Resize(, 22).ClearContents
    Range("A4").Resize(K, 22).Value = dArr
End If
MsgBox "Da Tong Hop Xong!", , "------Mr.GPE------"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Em cảm ơn hpkhuong nhiều ạ chương trình đã chạy đúng theo yêu cầu. Tuy nhiên mong anh có thể kiểm tra và sửa giúp em chút được không ạ khi chạy Code thì chương trình xóa mất dòng tiêu đề ạ
Em cảm ơn nhiều ạ

baquang1984 · 21/8/17

hpkhuong đã viết:

Mã:

Public Sub GPE()
Dim Wb As Workbook, sArr, dArr(1 To 50000, 1 To 22), I As Long, R As Long, K As Long
Dim J As Long, lR As Long, Rng As Range, Item, Ws As Worksheet, Tmp, Tmp2, Tmp3
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Application.FileDialog(msoFileDialogFilePicker)
    .AllowMultiSelect = True
    .Filters.Add "Microsoft Excel Files", "*.xls*", 1
    If Not .Show = -1 Then
        MsgBox "Ban chua chon File", vbInformation, "----Mr.GPE----"
        Exit Sub
    End If
On Error Resume Next
For Each Item In .SelectedItems
Set Wb = Workbooks.Open(Item)
Set Ws = Wb.Sheets("SoDiaChinh")
sArr = Ws.Range("A1", Ws.Range("A65000").End(3)).Resize(, 10).Value
    For I = 1 To UBound(sArr) Step 55
        If Len(sArr(I + 2, 1)) Then
            For R = 1 To 17
                If Len(sArr(I + R + 9, 1)) Then
                    K = K + 1
                    Tmp = Split(sArr(I + 2, 1), ",")
                    If Left(Tmp(0), 6) = "Hé «ng" Then
                        dArr(K, 6) = 1: dArr(K, 12) = 2
                    Else
                        dArr(K, 6) = 2: dArr(K, 12) = 1
                    End If
                    For J = 0 To UBound(Tmp)
                        dArr(K, J + 1) = Trim(Mid(Tmp(J), InStr(1, Tmp(J), ": ") + 2, Len(Tmp(J))))
                    Next
                    Tmp2 = Split(sArr(I + 4, 1), ",")
                  
                    For J = 0 To UBound(Tmp2)
                        dArr(K, J + 7) = Trim(Mid(Tmp2(J), InStr(1, Tmp2(J), ": ") + 2, Len(Tmp2(J))))
                    Next
                  
                    dArr(K, 13) = Mid(sArr(I + 3, 1), 10, Len(sArr(I + 3, 1)))
                    For J = 1 To 4
                        dArr(K, J + 13) = sArr(I + R + 9, J)
                    Next
                    For J = 6 To 10
                        dArr(K, J + 12) = sArr(I + R + 9, J)
                    Next
                End If
            Next
        End If
    Next
    Wb.Close
Next
End With
If K Then
lR = Range("A65000").End(3).Row
If lR > 3 Then Range("A4:A" & lR).Resize(, 22).ClearContents
    Range("A4").Resize(K, 22).Value = dArr
End If
MsgBox "Da Tong Hop Xong!", , "------Mr.GPE------"
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Em cảm ơn nhiều ạ. tường rằng sẽ không có ai giúp đỡ nhờ anh mà vấn đề của em đã được giải quyết.

Tổng hợi dữ liệu từ nhiều file Excel (1 người xem)

Người dùng đang xem chủ đề này

baquang1984

Thành viên tiêu biểu

File đính kèm

baquang1984

Thành viên tiêu biểu

baquang1984

Thành viên tiêu biểu

baquang1984

Thành viên tiêu biểu

baquang1984

Thành viên tiêu biểu

baquang1984

Thành viên tiêu biểu

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

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

Đếm ngược thời gian