Giúp đỡ rút gọn macro, giúp file Excel chạy nhanh hơn (1 người xem)

[SaveTheDay]

Mới làm quen với macro, nên mình đa số toàn dùng chức năng record, do đó file excel chạy khá chậm. Các bạn chỉnh lại ngắn lại dùm mình, hoặc đề xuất cho mình hướng giải quyết khác, với mục đích giúp file chạy nhanh hơn.
Thank

 

[SaveTheDay]

Vẫn đang chờ đợi sự trợ giúp.

 

[hungpecc1]

Vẫn đang chờ đợi sự trợ giúp.

bạn trình bày cụ thể và chi tiết hơn về Mục Đích ( Ví dụ thì càng tốt ) --> chứ xem code của bạn hoa hết cả mắt luôn và mất nhiều time !

---> nhịp sống bây giờ nhanh lắm,

 

[nhapmon]

mình cũng biết chút ít về vba thôi, một số góp ý với bạn như sau:

trong phần tính giá trị shortage, mình rút lại như sau:
Sub Tinhshortage()
'Tinh gia tri shortage
lr = Sheet4.[B5000].End(xlUp).Row
Sheet6.Range("C1:G" & lr).Value = Sheet4.Range("B1:F" & lr).Value
Sheet6.Range("G1:G" & lr).Value = Sheet4.Range("B1:B" & lr).Value
Sheet6.Range("S1:S" & lr).Value = Sheet4.Range("H1:H" & lr).Value
Sheets("Tamtinh").Select
..............................................code sort của bạn
End Sub

bạn nên tránh select cell. vì làm như vậy code phải di chuyển qua các cell làm chậm và màn hình nhảy từng tưng khó chịu lắm.
phần sort thì mình ko biết bạn định làm gì

trong sub Ton() cũng vậy, viết thẳng vào cel luôn
vi du:
Range("A2").Select
ActiveCell.FormulaR1C1 = "=Ten!RC[1]"
viết lại là
[A2]=shẹet2.[A2].

hay muốn copy toàn bộ tên bên sheet đó qua thì như vậy
lr = Sheet2.[B5000].End(xlUp).Row
Sheet5.Range("A2:A" & lr).Value = Sheet2.Range("B2:B" & lr).Value

bạn đọc các mục tăng tốc cho code trên diễn đàn rồi cải thiện code cho mình.
chúc bạn thành công

 

[SaveTheDay]

Uhm đúng là mình để 1 đống code như vây khó coi quá. Mình sẽ ngắt ra và nói rõ mục đích của mình. Sau đó nhờ các bạn rút gọn lại dùm mình để bảng tính chạy nhanh hơn.

'Tinh gia tri shortage
Application.Calculation = xlAutomatic
Sheets("Xuat").Range("B1:F1000000").Copy
Sheets("Tamtinh").Range("C1").PasteSpecial Paste:=xlPasteValues
Sheets("Xuat").Range("G1:G1000000").Copy
Sheets("Tamtinh").Range("B1").PasteSpecial Paste:=xlPasteValues
Sheets("Xuat").Range("S1:S1000000").Copy
Sheets("Tamtinh").Range("H1").PasteSpecial Paste:=xlPasteValues
Sheets("Tamtinh").Select

Mục đích của mình là Copy dữ liệu cột: sheet "xuat" B1:F1000000 đến sheet "Tamtinh"C1:G1000000

sheet "xuat" G1:G1000000 đến sheet "Tamtinh" B1:B1000000
sheet "xuat" S1:S1000000 đến sheet "Tamtinh" H1:H1000000

Vì dữ liệu file xuất mình phát sinh nhiều nên mình copy 1.000.000 hàng, có cách nào chỉ copy khi co dữ liệu xin chỉ dùm mình

@ Nhap mon
Bạn có thể giải thích sơ qua về code của bạn không
Phần sort là mình làm theo yêu cầu sắp xếp dữ liệu, đầu tiên mình sắp xếp A->Z theo cột D, sau đó sắp xếp lại A->Z theo cột C, cuối cùng là theo cột B. Code bên dưới hoàn toàn là record, mình không biết bỏ đi những phần nào không cần thiết, bạn chỉ dùm mình để thun gọn lại

Thank

ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Add Key:=Range("D2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tamtinh").Sort
.SetRange Range("B2:J1000000")
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Add Key:=Range("C2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tamtinh").Sort
.SetRange Range("B2:J1000000")
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Tamtinh").Sort.SortFields.Add Key:=Range("B2"), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets("Tamtinh").Sort
.SetRange Range("B2:J1000000")
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With

 

[Quang_Hải]

Mới làm quen với macro, nên mình đa số toàn dùng chức năng record, do đó file excel chạy khá chậm. Các bạn chỉnh lại ngắn lại dùm mình, hoặc đề xuất cho mình hướng giải quyết khác, với mục đích giúp file chạy nhanh hơn.
Thank

Mình sửa giúp cho bạn 1 đoạn đến phần sort dữ liêu. Phần còn lại cũng đơn giản thôi. Bạn chịu khó vọc nha.

Sub Tinhshortage()
Dim xuat As Worksheet
Set xuat = Sheets("Xuat")
    With Sheets("Tamtinh")
        xuat.Range(xuat.[B1], xuat.[F1000000].End(3)).Copy
        .Range("C1").PasteSpecial 3
        xuat.Range(xuat.[G1], xuat.[G1000000].End(3)).Copy
        .Range("B1").PasteSpecial 3
        xuat.Range(xuat.[S1], xuat.[S1000000].End(3)).Copy
        .Range("H1").PasteSpecial 3
        .Range(.[B2], .[J1000000].End(3)).Sort key1:=[D1], key2:=[C1], key3:=[B1], Header:=1
    End With
End Sub

 

[SaveTheDay]

Phần copy sheet xuat qua tam tạm tốc độ được cải thiện rõ ràng, nhưng phần sort nó không chạy bạn ơi

 

[Quang_Hải]

Phần copy sheet xuat qua tam tạm tốc độ được cải thiện rõ ràng, nhưng phần sort nó không chạy bạn ơi

Bạn nói sort theo 3 cột, thì code rất rõ ràng là cột D, rồi cột C và cuối cùng là cột B. Nếu không chạy thì chịu thôi vì khả năng mình chỉ có thể viết bi nhiêu đó thôi. Không biết có bạn nào viết khác hay không. Bạn kiên nhẫn đợi nhé.

 

[SaveTheDay]

Uhm dữ liệu copy qua thì ok, nhưng nó lại không sort. Nhưng dù sao cũng cám ơn bạn nhiều

 

[nmhung49]

Bạn sửa lại đoạn code này

.Range(.[B2], .[J1000000].End(3)).Sort key1:=[D1], key2:=[C1], key3:=[B1], Header:=1

Thành vậy xem sau có thể bị thiếu vài key cho phép

.Range(.[B2], .[J1000000].End(3)).Sort [D1], xlAscending, [C1], , xlAscending, [B1], xlAscending, xlYes

 

[SaveTheDay]

Code trên cũng không chạy được bạn ah, nhưng dù sao cũng cám ơn bạn, mình điều chỉnh lại như sau, dù có hơi dài dòng nhưng tốc độ chạy cũng khá

Dim xuat As Worksheet
Set xuat = Sheets("Xuat")
With Sheets("Tamtinh")
xuat.Range(xuat.[B1], xuat.[F1000000].End(3)).Copy
.Range("C1").PasteSpecial 3
xuat.Range(xuat.[G1], xuat.[G1000000].End(3)).Copy
.Range("B1").PasteSpecial 3
xuat.Range(xuat.[S1], xuat.[S1000000].End(3)).Copy
.Range("H1").PasteSpecial 3
'Sort
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=Range("B2"), Order:=xlAscending
.Sort.SortFields.Add Key:=Range("C2"), Order:=xlAscending
.Sort.SortFields.Add Key:=Range("D2"), Order:=xlAscending
With .Sort
.SetRange Range("B2:J1000000")
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With