Giúp rút gọn và cải thiện tốc độ code copy

babyheomoi · 31/12/21

Hi mọi người, em có marco 1 code, sửa ít ít theo ý mình, tuy nhiên theo cá nhân em thấy nó chạy chưa mượt (lâu lâu lag) và lấy nhiều data thừa quá.
Nhờ mọi người xem và cải tiến code giúp em ạ!

Mã:

Sub NEW_COPY()
'
' NEW_COPY Macro
'

'
    Sheets("TEST").Range("B9:AY5000").ClearContents
    Sheets("DATA").Select
    Call BUNG_RA    'code nay Unhide het cac cell bi hidden
    
    d = Sheets("DATA").Range("C5000").End(xlUp).Row
    Dim i
    Sheets("DATA").Range("HW:HW,HU:HU, BC:BF, AY:AY, AX:AX, AW:AW, AR:AR, C:AC,CP:CZ,BR:BR").Copy
    '=> cac cot can lay, tuong lai co the lay them vai cot nua
    
    Sheets("TEST").Select
    Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Sheets("DATA").Select
    Application.CutCopyMode = False
    Sheets("TEST").Select
    Range("B8").FormulaR1C1 = "1"
    Range("C8").FormulaR1C1 = "2"
    Range("B8:C8").AutoFill Destination:=Range("B8:BB8"), Type:=xlFillDefault
    ' danh so thu tu tu o b8 den BB8 =>hien tai danh stt bi du
    '=> Em muon danh so thu tu vua du, tuc data cac cot thi moi danh so TT
    Range("1:4").Clear  ' data thua => clear bot
    Cells.ClearFormats  ' data nhieu, xai qua nhieu format nen gay loi over flow
    '=> xoa format thi ok ko loi nua
    With Range("B8:BB8")
        .Interior.Color = 65535
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "Times New Roman"
        .Font.Size = 14
    End With
    Sheets("TEST").Range("a1").Select
    Call xoa_dong ' xoa cac dong trong
    MsgBox ("DA COPY DATA XONG")
End Sub

Sub xoa_dong()


d = Sheets("DATA").Range("C2000").End(xlUp).Row + 100
Dim i
With Sheets("TEST")
    For i = 9 To d
        If Range("B" & i).Value = "" Then
        Rows(i).Delete
        End If
    Next i
End With
End Sub

Em cám ơn ạ!

giaiphap · 31/12/21

babyheomoi đã viết:

Hi mọi người, em có marco 1 code, sửa ít ít theo ý mình, tuy nhiên theo cá nhân em thấy nó chạy chưa mượt (lâu lâu lag) và lấy nhiều data thừa quá.
Nhờ mọi người xem và cải tiến code giúp em ạ!

Mã:

Sub NEW_COPY()
'
' NEW_COPY Macro
'

'
    Sheets("TEST").Range("B9:AY5000").ClearContents
    Sheets("DATA").Select
    Call BUNG_RA    'code nay Unhide het cac cell bi hidden
   
    d = Sheets("DATA").Range("C5000").End(xlUp).Row
    Dim i
    Sheets("DATA").Range("HW:HW,HU:HU, BC:BF, AY:AY, AX:AX, AW:AW, AR:AR, C:AC,CP:CZ,BR:BR").Copy
    '=> cac cot can lay, tuong lai co the lay them vai cot nua
   
    Sheets("TEST").Select
    Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
    Sheets("DATA").Select
    Application.CutCopyMode = False
    Sheets("TEST").Select
    Range("B8").FormulaR1C1 = "1"
    Range("C8").FormulaR1C1 = "2"
    Range("B8:C8").AutoFill Destination:=Range("B8:BB8"), Type:=xlFillDefault
    ' danh so thu tu tu o b8 den BB8 =>hien tai danh stt bi du
    '=> Em muon danh so thu tu vua du, tuc data cac cot thi moi danh so TT
    Range("1:4").Clear  ' data thua => clear bot
    Cells.ClearFormats  ' data nhieu, xai qua nhieu format nen gay loi over flow
    '=> xoa format thi ok ko loi nua
    With Range("B8:BB8")
        .Interior.Color = 65535
        .Font.Bold = True
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .Font.Name = "Times New Roman"
        .Font.Size = 14
    End With
    Sheets("TEST").Range("a1").Select
    Call xoa_dong ' xoa cac dong trong
    MsgBox ("DA COPY DATA XONG")
End Sub

Sub xoa_dong()


d = Sheets("DATA").Range("C2000").End(xlUp).Row + 100
Dim i
With Sheets("TEST")
    For i = 9 To d
        If Range("B" & i).Value = "" Then
        Rows(i).Delete
        End If
    Next i
End With
End Sub

Em cám ơn ạ!

Cách nhanh nhất là bạn up file lên đây để xem chứ không có file hơi khó, VD chổ Call BUNG_RA của bạn ai biết nó là gì? Nhưng nhìn code là biết nó chậm rồi, muốn nhanh có file là nhanh nhất.

babyheomoi · 31/12/21

Cám ơn anh, e đã up file ạ. Tuy nhiên file nặng quá nên e up drive ạ!

help gpe.xlsb

drive.google.com

Mã:

Sub BUNG_RA()
'
' BUNG_RA Macro
'

'
    Sheets("DATA").Select
    Cells.EntireColumn.Hidden = False
    Cells.EntireRow.Hidden = False
    Range("C11").Select
End Sub

Module BUNG_RA đơn giản vậy thôi ạ!
Mấy bác đừng cười, nhưng thực sự sheet DATA nặng vì còn đụng nhiều phòng nên tạm thời chưa có cách và thời gian để làm lại data. Em làm code vba để nhìn đỡ rối và lọc báo cáo cho bản thân em dễ dàng.
Mọi người xem còn cần cải thiện gì giúp đỡ em với nha!

giaiphap đã viết:
Cách nhanh nhất là bạn up file lên đây để xem chứ không có file hơi khó, VD chổ Call BUNG_RA của bạn ai biết nó là gì? Nhưng nhìn code là biết nó chậm rồi, muốn nhanh có file là nhanh nhất.

Ah sẵn up file em muốn hỏi luôn vấn đề thứ 2: sheet BC TONG mục đích là e double check data của em với 1 data report khác của kế toán, nhưng em xài hàm vlookup nhiều quá nên load lâu và hay báo edit link. Trong khi cái này có thể 2-3 ngày 1 tuần em mới update. File report KT và file của em luôn nằm chung 1 folder.
Vậy code vba thế nào để lấy data Kt mỗi khi click (em có seach thì thấy có nhiều cách, có thấy cả cách xài ADO....). nên nếu được mọi người giúp e khúc này luôn ạ!

giaiphap · 31/12/21

Thử lại code này.

Mã:

Sub NEW_COPY()
'
' NEW_COPY Macro
'

Dim i%, d%, Rng As Range
    With Sheets("TEST")
        .Range("B9:AY5000").ClearContents
        Sheets("DATA").Cells.EntireColumn.Hidden = False
        Sheets("DATA").Cells.EntireRow.Hidden = False
        d = Sheets("DATA").Range("C5000").End(xlUp).Row
        Sheets("DATA").Range("HW:HW,HU:HU, BC:BF, AY:AY, AX:AX, AW:AW, AR:AR, C:AC,CP:CZ,BR:BR").Copy
        '=> cac cot can lay, tuong lai co the lay them vai cot nua
        
        .Range("B1").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
        .Range("B8").Value2 = "1"
        .Range("C8").Value2 = "2"
        .Range("B8:C8").AutoFill Destination:=.Range("B8:BB8"), Type:=xlFillDefault
        ' danh so thu tu tu o b8 den BB8 =>hien tai danh stt bi du
        '=> Em muon danh so thu tu vua du, tuc data cac cot thi moi danh so TT
        .Cells.ClearFormats  ' data nhieu, xai qua nhieu format nen gay loi over flow
        '=> xoa format thi ok ko loi nua
        With .Range("B8:BB8")
            .Interior.Color = 65535
            .Font.Bold = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .Font.Name = "Times New Roman"
            .Font.Size = 14
        End With
        d = Sheets("DATA").Range("C2000").End(xlUp).Row + 100
        For i = 9 To d
            If .Range("B" & i).Value = "" Then
                Set Rng = .Rows(i)
            Else
                Set Rng = Union(Rng, .Rows(i))
            End If
        Next i
        If Not Rng Is Nothing Then Rng.EntireRow.Delete
    End With
    MsgBox ("DA COPY DATA XONG")
End Sub

Bài đã được tự động gộp: 31/12/21

babyheomoi đã viết:
Ah sẵn up file em muốn hỏi luôn vấn đề thứ 2: sheet BC TONG mục đích là e double check data của em với 1 data report khác của kế toán, nhưng em xài hàm vlookup nhiều quá nên load lâu và hay báo edit link. Trong khi cái này có thể 2-3 ngày 1 tuần em mới update. File report KT và file của em luôn nằm chung 1 folder.
Vậy code vba thế nào để lấy data Kt mỗi khi click (em có seach thì thấy có nhiều cách, có thấy cả cách xài ADO....). nên nếu được mọi người giúp e khúc này luôn ạ!

Đưa file report KT lên đây và mô tả chi tiết hơn vấn đề mình cần.

Giúp rút gọn và cải thiện tốc độ code copy

babyheomoi

Thành viên thường trực

giaiphap

==(^o^)==

babyheomoi

Thành viên thường trực

help gpe.xlsb

giaiphap

==(^o^)==

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