Em cần giúp đỡ về vba macro copy paste ạ

noscudnart · 27/8/24

Em mới tập dùng vba thì tham khảo đoạn mã copy paste này trên youtube người ta hướng dẫn
mới đầu copy cho 1 bảng thì không sao nhưng tạo đến bảng thứ 3 vẫn loop lại cái code đấy thì có vẻ máy xử lý nhiều lệnh hơn chậm hơn, nếu thêm vài bảng nữa thì có vẻ không ổn
Mọi người hướng dẫn em tối ưu lại đoạn code dưới, hoặc có thể dùng phương pháp khác để tối ưu hơn được không ạ, em cảm ơn

Mã:

Sub Macro3()
    If Sheets("live").Range("b1").Value > 0 Then
    Sheets("live").Range("b1").Copy
    Dim dongcuoi As Long
    dongcuoi = Sheets("data").Range("A10000").End(xlUp).Row + 1
    Sheets("data").Range("A" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C8").Copy
    Sheets("data").Range("B" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C9").Copy
    Sheets("data").Range("C" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C10").Copy
    Sheets("data").Range("D" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("b1").Copy
    Sheets("data").Range("F" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C17").Copy
    Sheets("data").Range("G" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C18").Copy
    Sheets("data").Range("H" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C19").Copy
    Sheets("data").Range("I" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("b1").Copy
    Sheets("data").Range("K" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C21").Copy
    Sheets("data").Range("L" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C22").Copy
    Sheets("data").Range("M" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Sheets("live").Range("C23").Copy
    Sheets("data").Range("N" & dongcuoi).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    MsgBox "ok babe", vbInformation, "Thong bao"
    Else
    MsgBox "Quên chua nhâp ngày kìa @@", vbCritical, "Ðoi môt chút !!"
    End If
    End Sub

BuiQuangThuan · 27/8/24

noscudnart đã viết:
Em mới tập dùng vba thì tham khảo đoạn mã copy paste này trên youtube người ta hướng dẫn
mới đầu copy cho 1 bảng thì không sao nhưng tạo đến bảng thứ 3 vẫn loop lại cái code đấy thì có vẻ máy xử lý nhiều lệnh hơn chậm hơn, nếu thêm vài bảng nữa thì có vẻ không ổn
Mọi người hướng dẫn em tối ưu lại đoạn code dưới, hoặc có thể dùng phương pháp khác để tối ưu hơn được không ạ, em cảm ơn

Bạn đính kèm file lên đi

Hoàng Tuấn 868 · 27/8/24

BuiQuangThuan đã viết:
Bạn đính kèm file lên đi

Trước mắt chỉ cần thêm;
Application.ScreenUpdating = False
Application.ScreenUpdating = True
vào hai đầu thôi đã.

noscudnart · 27/8/24

BuiQuangThuan đã viết:
Bạn đính kèm file lên đi

em đính kèm rồi đó ạ

Bài đã được tự động gộp: 27/8/24

Hoàng Tuấn 868 đã viết:
Trước mắt chỉ cần thêm;
Application.ScreenUpdating = False
Application.ScreenUpdating = True
vào hai đầu thôi đã.

tks bác, nó mất hiện tượng load sheet chậm chậm rồi ạ. mã này có tác dụng là gì vậy ạ

Hoàng Tuấn 868 · 27/8/24

noscudnart đã viết:
tks bác, nó mất hiện tượng load sheet chậm chậm rồi ạ. mã này có tác dụng là gì vậy ạ

1/ Bạn không nên chèn tiếng Tây không cần thiết vào bài viết.
2/ Tác dụng của mã này thì bạn gõ tìm kiếm rồi tự tìm hiểu thì sẽ nhớ lâu hơn.

noscudnart · 27/8/24

Hoàng Tuấn 868 đã viết:
1/ Bạn không nên chèn tiếng Tây không cần thiết vào bài viết.
2/ Tác dụng của mã này thì bạn gõ tìm kiếm rồi tự tìm hiểu thì sẽ nhớ lâu hơn.

dạ em sẽ lưu ý
hiện tại dùng đoạn mã này áp dụng vào bảng của em thì nhanh hơn thật. nhưng theo em tìm hiểu thì đoạn mã này nó chỉ ẩn đi quá trình macro thôi sợ sau thêm vài vòng mã này nữa nó đổi từ chậm thành đơ 1 lúc rồi hiện kết quả.
liệu mã trên có thể thêm tác vụ ctrl bôi đen sao chép nhiều dòng rồi dán tách từng dòng được không ạ

BuiQuangThuan · 27/8/24

noscudnart đã viết:
dạ em sẽ lưu ý
hiện tại dùng đoạn mã này áp dụng vào bảng của em thì nhanh hơn thật. nhưng theo em tìm hiểu thì đoạn mã này nó chỉ ẩn đi quá trình macro thôi sợ sau thêm vài vòng mã này nữa nó đổi từ chậm thành đơ 1 lúc rồi hiện kết quả.
liệu mã trên có thể thêm tác vụ ctrl bôi đen sao chép nhiều dòng rồi dán tách từng dòng được không ạ

Sửa code cũ thành code này xem thế nào

Mã:

Sub Macro3()
    Dim R&, Ngay&, Ws As Worksheet, n
    Application.ScreenUpdating = False
    Set Ws = Sheets("Data")
    With Sheets("live")
        Ngay = .Range("B1").Value
        If Ngay <> Empty Then
            R = Ws.Range("A" & Rows.Count).End(3).Row + 1
            For Each n In Array(8, 17, 21)
                Select Case n
                    Case 8
                        Ws.Cells(R, 2).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 17
                        Ws.Cells(R, 7).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 21
                        Ws.Cells(R, 12).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                End Select
            Next
            Ws.Range("A" & R & ",F" & R & ",K" & R).Value = Ngay
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "OK"
End Sub

Hoàng Tuấn 868 · 27/8/24

noscudnart đã viết:
dạ em sẽ lưu ý
hiện tại dùng đoạn mã này áp dụng vào bảng của em thì nhanh hơn thật. nhưng theo em tìm hiểu thì đoạn mã này nó chỉ ẩn đi quá trình macro thôi sợ sau thêm vài vòng mã này nữa nó đổi từ chậm thành đơ 1 lúc rồi hiện kết quả.
liệu mã trên có thể thêm tác vụ ctrl bôi đen sao chép nhiều dòng rồi dán tách từng dòng được không ạ

Bạn mới tiếp cận VBA thì cứ tìm hiểu dần từng bước, bạn tham khảo tại đây xem nhé.

BuiQuangThuan · 27/8/24

Hoàng Tuấn 868 đã viết:
Bạn mới tiếp cận VBA thì cứ tìm hiểu dần từng bước, bạn tham khảo tại đây xem nhé.

Học tới bài 10 là cũng tương đối rồi ấy anh nhỉ

noscudnart · 27/8/24

Hoàng Tuấn 868 đã viết:
Bạn mới tiếp cận VBA thì cứ tìm hiểu dần từng bước, bạn tham khảo tại đây xem nhé.

dạ, em đang học tham khảo link này ạ

BuiQuangThuan đã viết:

Sửa code cũ thành code này xem thế nào

Mã:

Sub Macro3()
    Dim R&, Ngay&, Ws As Worksheet, n
    Application.ScreenUpdating = False
    Set Ws = Sheets("Data")
    With Sheets("live")
        Ngay = .Range("B1").Value
        If Ngay <> Empty Then
            R = Ws.Range("A" & Rows.Count).End(3).Row + 1
            For Each n In Array(8, 17, 21)
                Select Case n
                    Case 8
                        Ws.Cells(R, 2).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 17
                        Ws.Cells(R, 7).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 21
                        Ws.Cells(R, 12).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                End Select
            Next
            Ws.Range("A" & R & ",F" & R & ",K" & R).Value = Ngay
        End If
    End With
    Application.ScreenUpdating = True
    MsgBox "OK"
End Sub

cảm ơn anh, đúng thứ em cần rồi ạ, mà trong bài 10 link trên không có dậy phần case này
code trên của anh em áp vào thử thì nó lặp lại 3 giá trị đầu của mảng thôi a ạ, em phải lấy giá trị từng mảng 1 thế này không biết có đúng không ạ

Mã:

If Ngay <> Empty Then
            R = Ws.Range("A" & Rows.Count).End(3).Row + 1
            For Each n In Array(8, 9, 10, 17, 18, 19, 21, 22, 23)
                Select Case n
                    Case 8
                        Ws.Cells(R, 2).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 9
                        Ws.Cells(R, 3).Resize(, 2).Value = .Cells(n, 3).Resize(2).Value
                    Case 10
                        Ws.Cells(R, 4).Resize(, 1).Value = .Cells(n, 3).Resize(1).Value
                    Case 17
                        Ws.Cells(R, 7).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 18
                        Ws.Cells(R, 8).Resize(, 2).Value = .Cells(n, 3).Resize(2).Value
                    Case 19
                        Ws.Cells(R, 9).Resize(, 1).Value = .Cells(n, 3).Resize(1).Value
                    Case 21
                        Ws.Cells(R, 12).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 22
                        Ws.Cells(R, 13).Resize(, 2).Value = .Cells(n, 3).Resize(2).Value
                    Case 23
                        Ws.Cells(R, 14).Resize(, 1).Value = .Cells(n, 3).Resize(1).Value
                        
                End Select
            Next
            Ws.Range("A" & R & ",F" & R & ",K" & R).Value = Ngay
        End If

VetMini · 27/8/24

BuiQuangThuan đã viết:

Sửa code cũ thành code này xem thế nào

Mã:

Sub Macro3()
...
            For Each n In Array(8, 17, 21)
                Select Case n
                    Case 8
                        Ws.Cells(R, 2).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 17
                        Ws.Cells(R, 7).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                    Case 21
                        Ws.Cells(R, 12).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
                End Select
            Next
'...

Chỗ này luộm thuộm quá, magic numbers (8, 17, 21) nhắc lại hai lần, khó khăn cho sửa đổi về sau.
Mà chính ra tại sao phải dùng n để đọc cái array(8, 12, 21) tooic ũng chả rõ. Tại sao không đọc trực tiếp Array(2, 7, 12)

For each e in Array(2, 7, 12)
Ws.Cells(R, e).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
Next e

For e = 2 To 12 Step 5
Ws.Cells(R, e).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
Next e

Cực chẳng đã, phải dùng cặp đôi thì array nó như vầy:
For each e in Array(array(8, 2), array(17, 7), array(21, 12))
Ws.Cells(R, e(1)).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
Next e
' phải e(1) bởi vì e(0) là 8, 17, 21

BuiQuangThuan đã viết:
Hoàng Tuấn 868 đã viết:

Bạn mới tiếp cận VBA thì cứ tìm hiểu dần từng bước, bạn tham khảo tại đây xem nhé.

Nhấp chuột vào đây để mở rộng...

Học tới bài 10 là cũng tương đối rồi ấy anh nhỉ

Trình độ mới học mà bảo học tới bài #10 là tương ớt rồi chứ tương đối tương đỗ gì.

BuiQuangThuan · 27/8/24

VetMini đã viết:
For each e in Array(2, 7, 12)
Ws.Cells(R, e).Resize(, 3).Value = .Cells(n, 3).Resize(3).Value
Next e

Đúng chú chỉ cháu mới thấy đi vòng quanh. Là như này chẳng phải ra luôn rồi nè

Hoàng Tuấn 868 · 27/8/24

VetMini đã viết:
là tương ớt rồi chứ tương đối tương đỗ gì.

BuiQuangThuan đã viết:
Đúng chú chỉ cháu mới thấy

Nhắc đến "tương ớt" lại thấy thèm phở.

VetMini · 28/8/24

Hoàng Tuấn 868 đã viết:
Nhắc đến "tương ớt" lại thấy thèm phở.

Tôi thì đang lúc thèm gỏi đu đủ khô bò (phá lấu)

Em cần giúp đỡ về vba macro copy paste ạ

noscudnart

Thành viên mới

File đính kèm

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Hoàng Tuấn 868

Đăng ký hôm qua

noscudnart

Thành viên mới

Hoàng Tuấn 868

Đăng ký hôm qua

noscudnart

Thành viên mới

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Hoàng Tuấn 868

Đăng ký hôm qua

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

noscudnart

Thành viên mới

VetMini

Ăn cùng góc phố

BuiQuangThuan

❆❆❆❆❆❆❆❆❆❆❆❆

Hoàng Tuấn 868

Đăng ký hôm qua

VetMini

Ăn cùng góc phố

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