Giúp em cải thiện tốc độ code với ạ

Liên hệ QC
N

nhnn1986

Thành viên hoạt động
Tham gia
30/10/17
Bài viết
108
Được thích
19
Giới tính
Nam
EM chào Anh/Chị GPE:

Em muốn tổng cộng số liệu của nhiều sheet từ nhiều file vào file TOTAL, kết cấu các file nguồn giống nhau: COVID19-aaaaaaaa-bbbbbb-.....xlsx
Mỗi sheet cần cộng em làm 01 code để chạy, vì vậy nếu cần cộng 10 sheets thì làm 10 button xong gán macro.
Em có tham khảo và làm code như file đính kèm, code chạy được mỗi tội chạy quá lâu, tận 274 giây để cộng 156 file ạ. Lúc chạy code thì máy treo đến khi cộng xong luôn nên cứ ngồi chờ code chạy. Mong Anh/Chị có thể giúp em cải thiện code chạy nhanh hơn được không ạ? EM đính kèm code của em và 01 file nguồn (thực chất là cả trăm file nguồn ạ)

Em cảm ơn trước ạ./.
 

File đính kèm

  • COVID19-aaaaaaaa-bbbbbb-PLAll.xlsx
    13.6 KB · Đọc: 18
  • time.jpg
    time.jpg
    22 KB · Đọc: 26
  • TOTAL.xlsm
    30.4 KB · Đọc: 23
Sắp xếp theo thời gian sắp xếp theo bầu chọn
nhnn1986 đã viết:
EM chào Anh/Chị GPE:

Em muốn tổng cộng số liệu của nhiều sheet từ nhiều file vào file TOTAL, kết cấu các file nguồn giống nhau: COVID19-aaaaaaaa-bbbbbb-.....xlsx
Mỗi sheet cần cộng em làm 01 code để chạy, vì vậy nếu cần cộng 10 sheets thì làm 10 button xong gán macro.
Em có tham khảo và làm code như file đính kèm, code chạy được mỗi tội chạy quá lâu, tận 274 giây để cộng 156 file ạ. Lúc chạy code thì máy treo đến khi cộng xong luôn nên cứ ngồi chờ code chạy. Mong Anh/Chị có thể giúp em cải thiện code chạy nhanh hơn được không ạ? EM đính kèm code của em và 01 file nguồn (thực chất là cả trăm file nguồn ạ)

Em cảm ơn trước ạ./.
Nhấp chuột vào đây để mở rộng...
Sao lại giống bài của Anh này thế nhỉ
1585321101818.png​
Nhìn thấy mấy cái COVID19 là chạy bán sống, bán chết rồi
 
Upvote 0
Chuyển qua manual Calculation đi trước khi chạy code, sẽ giảm dc khá nhiều thời gian đấy bạn.
 
Upvote 0
VetMini đã viết:
Chưa tới 2 giây một file. Chậm nỗi gì?
Máy của tôi mở Excel lên đã mất 20 giây; mỗi file mở lên cũng vài giây, tuỳ file nhỏ lớn.
Nhấp chuột vào đây để mở rộng...
Ý anh là tốc độ như vậy là bình thường ạ? nếu thế em copy luôn code cho 10 phụ lục kia ạ.
Cảm ơn anh nhá./.
 
Upvote 0
hpkhuong đã viết:
Với mình thì bài trên không tốn giây nào...
Dạo này có người giỏi thật. Đi tạo thớt hỏi vấn đề đơn giản... nhưng lại khéo khoe cái khó là mình giỏi.
Nhấp chuột vào đây để mở rộng...
Em không rõ là đang khen hay chê em nữa ạ hic hic.

Code kia em cũng tìm tòi, học hỏi trênmạng xong về chế ra như thế, thực sự lúc chạy code 156 file thì nó treo luôn Excel và các chương trình khác đang chạy "Not respoding" đến khi xong code thì mới thôi. Vì vậy em mới mạo muội hỏi xem còn cách nào ...hay, nhanh và không treo máy không thôi ạ.
 
Upvote 0
Cảm ơn Anh/Chị đã góp ý, có lẽ em sẽ dùng code cũ để chiến tiếp ạ, việc của em giờ là copy nó thành 10 code xong đổi tên PL để chạy ....10 lần.

Thanks./.
 
Upvote 0
nhnn1986 đã viết:
Cảm ơn Anh/Chị đã góp ý, có lẽ em sẽ dùng code cũ để chiến tiếp ạ, việc của em giờ là copy nó thành 10 code xong đổi tên PL để chạy ....10 lần.

Cảm ơn./.
Nhấp chuột vào đây để mở rộng...
Bạn thử Nhét hết mấy cái tên PL đó vào mảng. Mở File lên duyệt qua cái mảng tên đó lấy dữ liệu rồi đóng File chắc nhanh hơn 10 code lẻ
 
Upvote 0
PacificPR đã viết:
Bạn thử Nhét hết mấy cái tên PL đó vào mảng. Mở File lên duyệt qua cái mảng tên đó lấy dữ liệu rồi đóng File chắc nhanh hơn 10 code lẻ
Nhấp chuột vào đây để mở rộng...
Mình cũng thích cải mảng Array mà tập tành vài lần không thành công nên nản mất rồi. Nếu được bạn hướng dẫn ....sơ sơ đường mình đi với...
 
Upvote 0
nhnn1986 đã viết:
Mình cũng thích cải mảng Array mà tập tành vài lần không thành công nên nản mất rồi. Nếu được bạn hướng dẫn ....sơ sơ đường mình đi với...
Nhấp chuột vào đây để mở rộng...
Mình thêm 1 tẹo và Copy PL1 và PL2
1585458701053.png
PHP: 
Sub Copydata()
    Dim ShArray(), VungdulieuArray(), Idx As Long
    Dim ShName As String, Vungdulieu As String
    Dim FileNameXls As Variant, I As Integer, wb As Workbook, Sh As Worksheet
    Dim baseBook As Workbook, filenumber As Long, strttme As Single: strttme = Timer
ShArray = Array("PL01", "PL02")
VungdulieuArray = Array("C9:I38", "B6:I10")
Application.ScreenUpdating = False
Set baseBook = ThisWorkbook
baseBook.Sheets("PL02").Range("B6:I10").Clear
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)
If Not IsArray(FileNameXls) Then Exit Sub
For I = LBound(FileNameXls) To UBound(FileNameXls)
    Set wb = Workbooks.Open(FileNameXls(I))
    For Each Sh In wb.Sheets
        For Idx = 0 To UBound(ShArray)
            If Sh.Name = ShArray(Idx) Then
                ShName = ShArray(Idx): Vungdulieu = VungdulieuArray(Idx)
                wb.Sheets(ShName).Range(Vungdulieu).Copy
                baseBook.Sheets(ShName).Range(Vungdulieu).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False
                Application.CutCopyMode = False
                Exit For
            End If
        Next Idx
    Next
    wb.Close SaveChanges:=False
Next I
filenumber = UBound(FileNameXls)
Application.ScreenUpdating = True
baseBook.Sheets("main").Select
MsgBox "Da tong hop: " & filenumber & " files - Tong thoi gian: " & Format(Round(Timer - strttme, 3), "0.00") & " giay"
End Sub
 
Upvote 0
@PacificPR wow, mình cử tưởng thêm 1 vòng lặp để duyệt qua các sheet thì sẽ lâu. Đề mình thử dạng mảng này xem sao. Thanks./.
 
Upvote 0
Tuyệt vời bạn @PacificPR , mình thử code mảng của bạn 02 phụ lục 199 file mất 524 giây = 9 phút.

Giả sử 10 phụ lục có khi chạy hơn 1giờ nhỉ, hơi lâu mà thôi kệ.... lúc code chạy thì làm việc khác không đụng tới máy tính là được hi hi
 

File đính kèm

  • time199.jpg
    time199.jpg
    19.7 KB · Đọc: 16
Upvote 0
nhnn1986 đã viết:
Tuyệt vời bạn @PacificPR , mình thử code mảng của bạn 02 phụ lục 199 file mất 524 giây = 9 phút.

Giả sử 10 phụ lục có khi chạy hơn 1giờ nhỉ, hơi lâu mà thôi kệ.... lúc code chạy thì làm việc khác không đụng tới máy tính là được hi hi
Nhấp chuột vào đây để mở rộng...
Đang rảnh Test thử:
1585468508366.png​
Có tí dẫn chứng. Không lậy bẩu ăn gian :p:p:p
 
Upvote 0
PacificPR đã viết:
Mình thêm 1 tẹo và Copy PL1 và PL2
View attachment 234290
PHP: 
Sub Copydata()
    Dim ShArray(), VungdulieuArray(), Idx As Long
    Dim ShName As String, Vungdulieu As String
    Dim FileNameXls As Variant, I As Integer, wb As Workbook, Sh As Worksheet
    Dim baseBook As Workbook, filenumber As Long, strttme As Single: strttme = Timer
ShArray = Array("PL01", "PL02")
VungdulieuArray = Array("C9:I38", "B6:I10")
Application.ScreenUpdating = False
Set baseBook = ThisWorkbook
baseBook.Sheets("PL02").Range("B6:I10").Clear
FileNameXls = Application.GetOpenFilename(filefilter:="Excel Files, *.xl*", MultiSelect:=True)
If Not IsArray(FileNameXls) Then Exit Sub
For I = LBound(FileNameXls) To UBound(FileNameXls)
    Set wb = Workbooks.Open(FileNameXls(I))
    For Each Sh In wb.Sheets
        For Idx = 0 To UBound(ShArray)
            If Sh.Name = ShArray(Idx) Then
                ShName = ShArray(Idx): Vungdulieu = VungdulieuArray(Idx)
                wb.Sheets(ShName).Range(Vungdulieu).Copy
                baseBook.Sheets(ShName).Range(Vungdulieu).PasteSpecial Paste:=xlPasteValues, Operation:=xlAdd, SkipBlanks:=True, Transpose:=False
                Application.CutCopyMode = False
                Exit For
            End If
        Next Idx
    Next
    wb.Close SaveChanges:=False
Next I
filenumber = UBound(FileNameXls)
Application.ScreenUpdating = True
baseBook.Sheets("main").Select
MsgBox "Da tong hop: " & filenumber & " files - Tong thoi gian: " & Format(Round(Timer - strttme, 3), "0.00") & " giay"
End Sub
Nhấp chuột vào đây để mở rộng...
Sao không dùng ADO :)
 
Upvote 0
HieuCD đã viết:
Sao không dùng ADO :)
Nhấp chuột vào đây để mở rộng...
Em thử mò trên GPE mớ code và .... chắp vá bằng ADO chạy được file rõ ràng nhanh hơn mà lúc cộng thì bị sai số mất anh ạ.

Code này là: Copy hết PL01 vào sheets(PL01) => Sau đó tính tổng cộng vào phía dưới cùng của sheets(PL01)
Mất có 25 giây để tổng 199 files, mỗi tội số tổng cộng nó .... sai sai ạ.
Với lại code trong file em đính kèm chỉ cộng mỗi lần 01 sheets nguồn nên sẽ quay lại vấn đề ban đầu em mắc phải là .... làm 10 code để cộng 10 sheet
 

File đính kèm

  • time199ADO.jpg
    time199ADO.jpg
    53.2 KB · Đọc: 10
  • TOTAL.xlsm
    212.1 KB · Đọc: 6
Upvote 0
nhnn1986 đã viết:
Em thử mò trên GPE mớ code và .... chắp vá bằng ADO chạy được file rõ ràng nhanh hơn mà lúc cộng thì bị sai số mất anh ạ.

Code này là: Copy hết PL01 vào sheets(PL01) => Sau đó tính tổng cộng vào phía dưới cùng của sheets(PL01)
Mất có 25 giây để tổng 199 files, mỗi tội số tổng cộng nó .... sai sai ạ.
Với lại code trong file em đính kèm chỉ cộng mỗi lần 01 sheets nguồn nên sẽ quay lại vấn đề ban đầu em mắc phải là .... làm 10 code để cộng 10 sheet
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub xyz()
  Dim cn As Object, rs As Object, sFile As Object
  Dim shName, shRng, sArr, Res()
  Dim i&, j&, k&, n&

  With Application.FileDialog(msoFileDialogOpen)
    .Filters.Clear
    .Filters.Add "COVID", "*.xl*"
    .InitialFileName = "COVID*"
    .AllowMultiSelect = True
    If .Show <> -1 Then
      MsgBox ("Phai chon file! "): Exit Sub
    Else
      Set sFile = .SelectedItems
    End If
  End With
  Application.ScreenUpdating = False
  shName = Array("PL01", "PL02")
  shRng = Array("C9:I38", "B6:I10")
  ReDim Res(0 To UBound(shName))
  For k = 0 To UBound(shName)
    With Sheets(shName(k))
      .Range(shRng(k)).ClearContents
      Res(k) = .Range(shRng(k)).Value
    End With
  Next k
  Set cn = CreateObject("adodb.connection")
  Set fso = CreateObject("Scripting.FileSystemObject")
  For n = 1 To sFile.Count
    cn.Open ("provider=Microsoft.ACE.OLEDB.12.0;data source=" & sFile(n) & ";mode=Read;extended properties=""Excel 12.0;hdr=no"";")
    For k = 0 To UBound(shName)
      Set rs = cn.Execute("select * from [" & shName(k) & "$" & shRng(k) & "] ")
      If Not rs.EOF Then
        sArr = rs.GetRows
        For i = 0 To UBound(sArr, 2)
          For j = 0 To UBound(sArr)
            Res(k)(i + 1, j + 1) = Res(k)(i + 1, j + 1) + sArr(j, i)
          Next j
        Next i
      End If
      rs.Close
    Next k
    cn.Close
  Next n
  For k = 0 To UBound(shName)
    Sheets(shName(k)).Range(shRng(k)) = Res(k)
  Next k
  Set cn = Nothing: Set rs = Nothing: Set sFile = Nothing
  Application.ScreenUpdating = True
End Sub
 
Upvote 0
Há há, code chạy đúng ý em quá anh @HieuCD

Nhanh lại chuẩn,để mai em thêmvào mảng tới PL10 chạy xem sao ạ./.
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

dungluf123
Lỗi khi sử dụng công thức để link từ file này sang file khác của Excel trên hệ thống mạng chung của công ty
Trả lời
0
Đọc
18
dungluf123
dungluf123
V
Tìm điều kiện sau đó tính tổng ma hang theo điều kiện
Trả lời
5
Đọc
46
vnproc
V
hongphuong1997
  • Question
Lấy ký tự trong chuỗi theo nhiều điều kiện
Trả lời
0
Đọc
23
hongphuong1997
hongphuong1997
P
HÀM SUBTOTAL BỊ #VALUE
Trả lời
1
Đọc
24
DeTong
D
phanmoi688
[Xin nhờ giúp đỡ] Tìm cách xóa các ký tự trắng trong biểu
Trả lời
4
Đọc
44
phanmoi688
phanmoi688
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL

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

Back
Top Bottom