Em cần giúp đỡ về vba macro copy paste ạ (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
N

noscudnart

Thành viên mới
Tham gia
26/8/24
Bài viết
4
Được thích
0
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
1724757845647.png
1724757881990.png
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
 

File đính kèm

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
Nhấp chuột vào đây để mở rộng...
Bạn đính kèm file lên đi
 
BuiQuangThuan đã viết:
Bạn đính kèm file lên đi
Nhấp chuột vào đây để mở rộng...
em đính kèm rồi đó ạ
Bài đã được tự động gộp:

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 đã.
Nhấp chuột vào đây để mở rộng...
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 ạ
 
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 ạ
Nhấp chuột vào đây để mở rộng...
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.
 
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.
Nhấp chuột vào đây để mở rộng...
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 ạ
 
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 ạ
Nhấp chuột vào đây để mở rộ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
 
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 ạ
Nhấp chuột vào đây để mở rộ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é.
 
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...
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
Nhấp chuột vào đây để mở rộng...
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
 
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
'...
Nhấp chuột vào đây để mở rộng...
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ỉ
Nhấp chuột vào đây để mở rộng...
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ì.
 
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

vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện. (1 người xem)
Trả lời
12
Đọc
87
hoangtuaotrang_hp_vn
H
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô (1 người xem)
Trả lời
7
Đọc
173
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
517
Phạm Trường 80
P
L
Lỗi font khi convert từ pdf
Trả lời
1
Đọc
49
Hoàng Tuấn 868
H
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
75
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
74
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác (1 người xem)
Trả lời
4
Đọc
127
Gà Công Nghệ
Gà Công Nghệ
N
Mong mọi người giúp đỡ
Trả lời
1
Đọc
58
minhminh27
minhminh27
minhduc1o2
Excel lỗi font Time New Roman+
Trả lời
7
Đọc
113
minhduc1o2
minhduc1o2
F
  • Question Question
Tự động Merge Mail bằng VBA (1 người xem)
Trả lời
0
Đọc
72
fujishima
F
H
Lọc dữ liệu trong XL
    • Cười
Trả lời
0
Đọc
45
huong.dinh
H
giaiphap
Add-Ins hổ trợ Word trộn danh sách và lưu ra nhiều tệp tin khác nhau.
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
39
Đọc
9K
fujishima
F
K
xin file excel bảng đấu bóng đá (1 người xem)
    • Yêu thích
2 3
Trả lời
40
Đọc
25K
subin1905
S
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước.
    • Thích
2
Trả lời
24
Đọc
7K
chihuumvc
C
Trungvt3
Công thức trả về định dạng không như mong muốn và viết phân số trong 1 ô.
Trả lời
1
Đọc
64
bebo021999
B
G
Hướng dẫn Lập danh sách File
    • Không thích
Trả lời
16
Đọc
267
thanhhuy_hvnh
thanhhuy_hvnh
baolong240793
Nhờ Anh/Chị hỗ trợ em hàm Randbetween() với ạ.
Trả lời
4
Đọc
360
bebo021999
B
Y
  • Question Question
Khóa VBA với mật khẩu mở
    • Thích
2 3 4
Trả lời
60
Đọc
5K
PhanTuHuong
PhanTuHuong
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom