Nhờ giúp: macro Tổng hợp dữ liệu từ nhiều file

881516 · 20/7/17

quanluu1989 đã viết:
Vấn đề update link thì xử lý thế này xem sao:
Thêm dòng Application.DisplayAlerts = False ở đầu code (trước thằng ScreenUpdating)
và Application.DisplayAlerts = True cuối code (sau thằng Screen..)

Vẫn bị hiện bạn ah, thôi ko sao, cái này cứ ngồi dí nút enter là xong

PacificPR · 20/7/17

881516 đã viết:
Vẫn bị hiện bạn ah, thôi ko sao, cái này cứ ngồi dí nút enter là xong

Bạn chọn toàn bộ bảng tính Copy rồi Paste Value xem sao. Nhưng Code này cũng chưa ổn> nếu dữ liệu khoảng 90.000 dòng thì mất khoảng 17 giây (Tốc độ hơi chậm) trong khi đó Code của anh HieuCD mất có 9 giây . Bạn đẩy mỗi file con lên khoảng 30.000 dòng rồi test thử xem

phulien1902 · 20/7/17

PacificPR đã viết:
Bạn chọn toàn bộ bảng tính Copy rồi Paste Value xem sao. Nhưng Code này cũng chưa ổn> nếu dữ liệu khoảng 90.000 dòng thì mất khoảng 17 giây (Tốc độ hơi chậm). Bạn đẩy mỗi file con lên khoảng 30.000 dòng rồi test thử xem

Tôi không thể tưởng tượng được khi Borders 90.000 dòng thì mất thời gian bao lâu nhỉ?

quanluu · 20/7/17

881516 đã viết:
Vẫn bị hiện bạn ah, thôi ko sao, cái này cứ ngồi dí nút enter là xong

Không được thì dùng thêm cái này coi.
Application.AskToUpdateLinks = False

Mà trong Workbook.open có các lựa chọn
. Open( FileName , UpdateLinks , ReadOnly , Format , Password , WriteResPassword ,IgnoreReadOnlyRecommended , Origin , Delimiter , Editable , Notify , Converter , AddToMru ,Local , CorruptLoad )

Bạn cho UpdateLinks = False xem

PacificPR · 20/7/17

phulien1902 đã viết:
Tôi không thể tưởng tượng được khi Borders 90.000 dòng thì mất thời gian bao lâu nhỉ?

Nếu làm thủ công mất khoảng 7 đến 8 giây gì đó anh à

PacificPR · 20/7/17

quanluu1989 đã viết:
Không được thì dùng thêm cái này coi.
Application.AskToUpdateLinks = False

Mà trong Workbook.open có các lựa chọn
. Open( FileName , UpdateLinks , ReadOnly , Format , Password , WriteResPassword ,IgnoreReadOnlyRecommended , Origin , Delimiter , Editable , Notify , Converter , AddToMru ,Local , CorruptLoad )

Bạn cho UpdateLinks = False xem

Như thế này Set wk = Workbooks.Open(strFileName, UpdateLinks:=False)
Nếu là Code của anh HieuCD thì Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename, UpdateLinks:=False)
Đúng không anh

quanluu · 20/7/17

PacificPR đã viết:
Như thế này Set wk = Workbooks.Open(strFileName, UpdateLinks:=False)
Nếu là Code của anh HieuCD thì Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename, UpdateLinks:=False)
Đúng không anh

Chỉ cần thế này thui: Set wk = Workbooks.Open(strFileName, False)

881516 · 20/7/17

PacificPR đã viết:
Như thế này Set wk = Workbooks.Open(strFileName, UpdateLinks:=False)
Nếu là Code của anh HieuCD thì Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename, UpdateLinks:=False)
Đúng không anh

ui mấy cái này thì add vào chỗ nào vậy bạn

PacificPR · 20/7/17

881516 đã viết:
ui mấy cái này thì add vào chỗ nào vậy bạn

Bạn tìm trong Code có chữ nào là Set wk = ................... thì thay dòng đó bằng cái trên

HieuCD · 20/7/17

881516 đã viết:
Hi bạn
File của bạn OK
nhưng ví dụ tên lớp của mình là AK1 thì ở cột tên file nó nhảy tên lớp là AK1, AK2, AK3 chứ tất cả các học sinh trong lớp ko phải là AK1 nữa
b xem fix chỗ nào

bạn chỉnh lại code

Mã:

 Sub GopLop()
  Dim Sh As Worksheet, Wb_k As Workbook, Filename As String, Path As String
  Dim LastR As Long, Arr()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set Sh = ThisWorkbook.Sheets("Sheet1")
  LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then Sh.Range("A2:H" & LastR).Clear
 
  Path = ThisWorkbook.Path
  Filename = Dir(Path & "\*.xlsx", vbNormal)
  If Len(Filename) = 0 Then Exit Sub
  Do Until Filename = vbNullString
    If Not Filename = ThisWorkbook.Name Then
      Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename)
        With Wb_k.Sheets("Sheet1")
          LastR = .Range("A" & Rows.Count).End(xlUp).Row
          If LastR > 1 Then
            Arr = .Range("A2:G" & LastR).Value
            LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sh.Range("A" & LastR).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
          End If
         End With
      Wb_k.Close False
      Sh.Range("H" & LastR).Resize(UBound(Arr)) = Left(Filename, Len(Filename) - 5)
    End If
    Filename = Dir()
  Loop
  Sh.Range("A2:H" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "Tong Hop Xong!"
End Sub

PacificPR · 20/7/17

HieuCD đã viết:

bạn chỉnh lại code

Mã:

 Sub GopLop()
  Dim Sh As Worksheet, Wb_k As Workbook, Filename As String, Path As String
  Dim LastR As Long, Arr()
  Application.EnableEvents = False
  Application.ScreenUpdating = False
  Set Sh = ThisWorkbook.Sheets("Sheet1")
  LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row
  If LastR > 1 Then Sh.Range("A2:H" & LastR).Clear
 
  Path = ThisWorkbook.Path
  Filename = Dir(Path & "\*.xlsx", vbNormal)
  If Len(Filename) = 0 Then Exit Sub
  Do Until Filename = vbNullString
    If Not Filename = ThisWorkbook.Name Then
      Set Wb_k = Workbooks.Open(Filename:=Path & "\" & Filename)
        With Wb_k.Sheets("Sheet1")
          LastR = .Range("A" & Rows.Count).End(xlUp).Row
          If LastR > 1 Then
            Arr = .Range("A2:G" & LastR).Value
            LastR = Sh.Range("A" & Rows.Count).End(xlUp).Row + 1
            Sh.Range("A" & LastR).Resize(UBound(Arr), UBound(Arr, 2)) = Arr
          End If
         End With
      Wb_k.Close False
      Sh.Range("H" & LastR).Resize(UBound(Arr)) = Left(Filename, Len(Filename) - 5)
    End If
    Filename = Dir()
  Loop
  Sh.Range("A2:H" & Sh.Range("A" & Rows.Count).End(xlUp).Row).Borders.LineStyle = 1
  Application.ScreenUpdating = True
  Application.EnableEvents = True
  MsgBox "Tong Hop Xong!"
End Sub

Nhà Họ lên tới 18 cột chứ không phải 7 cột nữa roài anh ạ.

tuandandy · 20/7/17

PacificPR đã viết:
Bạn cho nó vào vòng lặp. Khi mở file lên duyệt qua các Sheet là được

B cho mình xem code với ạ, mình mới học vba chưa hiểu lắm. cám ơn b

befaint · 20/7/17

tuandandy đã viết:
B cho mình xem code với ạ, mình mới học vba chưa hiểu lắm. cám ơn b

Ở giữa trang, to tướng đó.
Đây gọi là code nè.

PacificPR · 20/7/17

tuandandy đã viết:
B cho mình xem code với ạ, mình mới học vba chưa hiểu lắm. cám ơn b

Bạn đính kèm file lên cho mọi người luyện chút cho đỡ quên bài, quên vở...

tuandandy · 20/7/17

PacificPR đã viết:
Bạn đính kèm file lên cho mọi người luyện chút cho đỡ quên bài, quên vở...

VẪN ví dụ trên ạ, nhưng í của mình là mình muốn chọn sheets trước khi gộp file đó bạn, trên code mặc định là sheets 1,

PacificPR · 20/7/17

tuandandy đã viết:
VẪN ví dụ trên ạ, nhưng í của mình là mình muốn chọn sheets trước khi gộp file đó bạn, trên code mặc định là sheets 1,

Bài 12 bạn nói 1file có ba tục sheet lận. Ai biết nó là cái gì mà làm hả bạn

tuandandy · 20/7/17

PacificPR đã viết:
Bài 12 bạn nói 1file có ba tục sheet lận. Ai biết nó là cái gì mà làm hả bạn

MÌNH MUỐN MỖI SHEETS CỦA FILE TOTAL LẤY DỮ LIỆU SHEETS TƯƠNG ỨNG CỦA FILE MTF 1, MTF2 BẠN Ạ

tuandandy · 20/7/17

PacificPR đã viết:
Bài 12 bạn nói 1file có ba tục sheet lận. Ai biết nó là cái gì mà làm hả bạn

Đoạn code này chỉ lấy dữ liệu được với sheets đầu tiên ở trên file con thôi phải k bạn

PacificPR · 20/7/17

tuandandy đã viết:
Đoạn code này chỉ lấy dữ liệu được với sheets đầu tiên ở trên file con thôi phải k bạn

Bạn xem thử file

Nhờ giúp: macro Tổng hợp dữ liệu từ nhiều file

Thành viên chính thức

Thành viên mới

File đính kèm

GPE - My love

Thành viên gắn bó

Thành viên mới

Thành viên mới

Thành viên gắn bó

Thành viên chính thức

Thành viên mới

Chuyên gia GPE

Thành viên mới

Thành viên mới

|||||||||||||

Thành viên mới

Thành viên mới

Thành viên mới

Thành viên mới

File đính kèm

Thành viên mới

Thành viên mới

File đính kèm

Facebook

Group