Từ code thô sủa thành code mới!

  • Thread starter Thread starter hcl_pt
  • Ngày gửi Ngày gửi
Liên hệ QC

hcl_pt

Thành viên thường trực
Tham gia
21/10/10
Bài viết
208
Được thích
11
Mình đã ghi record code với các thao tác lặp giống nhau và được đoạn code như sau:
Sub CODE()
'
' CODE Macro
'
'
Range("A5").Select
Selection.Copy
ActiveSheet.Paste
Range("A6").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A8").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A9").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A11").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A12").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A14").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A15").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A17").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A18").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A20").Select
Application.CutCopyMode = False
Selection.Copy
ActiveSheet.Paste
Range("A21").Select
Application.CutCopyMode = False
End Sub
- Nay mong muốn được các bạn chỉ cách sửa đoạn code trên như thế nào để nó ngắn gọn đi ạ? Xin cảm ơn!
 
Thật ra tôi cho bạn một Ví dụ, bạn tự sửa code của bạn ngắn gọn, với code của bạn là copy một điểm nào đó rồi paste, thì đây là một ví dụ:

PHP:
Sub Macro1()
  Range("A5").Copy Range("B5")
End Sub

Cũng hành động như trên, ngắn hơn một chút:

PHP:
Sub Macro2()
  [A5].Copy [B5]
End Sub

Và đây là copy giá trị ngắn nhất:

PHP:
Sub Macro3()
  [B5] = [A5]
End Sub

Bạn xem mà triển khai trong code của bạn.
 
Upvote 0
Mình đã ghi record code với các thao tác lặp giống nhau và được đoạn code như sau:
Sub CODE()
'
' CODE Macro
'
'
Range("A5").Select
Selection.Copy
ActiveSheet.Paste
Range("A6").Select
Application.CutCopyMode = False
...
End Sub

Như chữ đỏ, to, bạn copy và dán vô cùng 1 ô.
Hãy tập ghi macro 1 cách cẩn thận. Nếu bạn chép sang ô cột B cùng hàng thì làm như bạn
Learning_Excel
 
Lần chỉnh sửa cuối:
Upvote 0
Như chữ đỏ, to, bạn copy và dán vô cùng 1 ô.
Hãy tập ghi macro 1 cách cẩn thận. Nếu bạn chép sang ô cột B cùng hàng thì làm như bạn
Learning_Excel

Ở đây không phải cùng hàng hay khác hàng. Bạn có thể thay đổi địa chỉ ô nếu muốn. Đây là cách viết ngắn gọn, với cấu trúc như vậy bạn có thể tùy chỉnh trong mọi trường hợp. Lưu ý với kiểu này [B5] = [A5], với cấu trúc này: [D10:D13] = [D9:G9].Value bạn cần phải thêm Value và nơi đến đúng hàng đúng cột mới cho ra kết quả.

Lưu ý: khi paste còn có các cách paste specials nữa nó có cấu trúc paste specials khác nhau.
 
Lần chỉnh sửa cuối:
Upvote 0
Mình có đoạn code này do bác Concogia giúp đỡ! Để thực hiện được lệnh code thì mỗi lần chỉ có thể coppy và dán vào cột A ở sheet2 một ô: ví dụ: coppy dữ liệu 1;3&1;2 và dán vào cột A ở sheet2 thì code thực hiện, nếu coppy và dán vào một mảng thì lại không được: ví dụ: coppy dữ liệu 2 ô (hoặc nhiều hơn): 1;3&1;2 và 1;4&3;100 dán vào cột A ở sheet 2 thì code lại không thực hiện? Mong các bạn chỉ giúp vì mình số liệu nhiều nếu dán từng ô một thì thật sự rất mất nhiều thời gian! Rất cảm ơn các bạn! Code như sau:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim d, Vung, I, Tach, K, kK, Kq(1 To 1, 1 To 5) As String
On Error Resume Next
If Not Intersect(Target, Range("A4:a50000")) Is Nothing Then
Set d = CreateObject("scripting.dictionary")
Vung = Sheets("sheet1").Range(Sheets("sheet1").[a4], Sheets("sheet1").[a50000].End(xlUp)).Resize(, 6).Value
For I = 1 To UBound(Vung)
If Not d.exists(Vung(I, 1)) Then d.Add Vung(I, 1), I
Next I
If Target.Value <> "" Then
Tach = Split(Target, "&")
K = d.Item(Tach(0)): kK = d.Item(Tach(1))
If K = "" Or kK = "" Then MsgBox "Nhap tâm bay tâm ba, Nhap lai bo teo": ActiveCell.Offset(-1) = "": Exit Sub
For I = 1 To 5
Kq(1, I) = Vung(K, I + 1) & Vung(kK, I + 1)
Next I
Target.Offset(, 1).Resize(, 5) = Kq
End If
End If
End Sub
Mình xin gửi kèm theo file đính kèm!
 

File đính kèm

Upvote 0
Web KT

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

Back
Top Bottom