Nhờ giúp: macro Tổng hợp dữ liệu từ nhiều file (2 người xem)

[881516]

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]

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]

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]

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]

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]

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]

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]

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]

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]

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

 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]

bạn chỉnh lại code

 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]

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]

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]

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]

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]

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]

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]

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]

Đ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