Giúp tối giản code (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

tueyennhi

Thành viên tích cực
Tham gia
18/10/10
Bài viết
1,192
Được thích
105
Chào anh chị.

Anh chị xem code tối giản giúp em nhé. Em cảm ơn!

PHP: 
Sub Macro1()
Dim lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


With ActiveSheet
lr = .[c65000].End(3).Row
'Tong thoi gian
Range("M9").Select
Selection.AutoFill Destination:=Range("M9:M" & lr)
'TG AN 1
Range("P9").Select
Selection.AutoFill Destination:=Range("P9:P" & lr)
'TG AN 2
Range("S9").Select
Selection.AutoFill Destination:=Range("S9:S" & lr)
'Tong thoi gian lam viec thuc te
Range("T9").Select
Selection.AutoFill Destination:=Range("T9:T" & lr)
'Thoi gian duoc cong them
Range("U9").Select
Selection.AutoFill Destination:=Range("U9:U" & lr)
'Tong thoi gian duoc tinh
Range("V9").Select
Selection.AutoFill Destination:=Range("V9:V" & lr)
'Cong Ngay
Range("W9").Select
Selection.AutoFill Destination:=Range("W9:W" & lr)
'Cong Dem
Range("X9").Select
Selection.AutoFill Destination:=Range("X9:X" & lr)
'OVT N
Range("Y9").Select
Selection.AutoFill Destination:=Range("Y9:Y" & lr)
'OVT D1
Range("Z9").Select
Selection.AutoFill Destination:=Range("Z9:Z" & lr)
'OVT D2
Range("AA9").Select
Selection.AutoFill Destination:=Range("AA9:AA" & lr)
'Tong OVT
Range("AB9").Select
Selection.AutoFill Destination:=Range("AB9:AB" & lr)
'PC mua cao diem
Range("AC9").Select
Selection.AutoFill Destination:=Range("AC9:AC" & lr)
'Quy ra cong
Range("AG9").Select
Selection.AutoFill Destination:=Range("AG9:AG" & lr)
'Dieu kien
Range("AH9").Select
Selection.AutoFill Destination:=Range("AH9:AH" & lr)
'Cong chinh
Range("AI9").Select
Selection.AutoFill Destination:=Range("ai9:ai" & lr)
'N
Range("AJ9").Select
Selection.AutoFill Destination:=Range("aj9:aj" & lr)
'D1
Range("AK9").Select
Selection.AutoFill Destination:=Range("ak9:ak" & lr)
'D2
Range("AL9").Select
Selection.AutoFill Destination:=Range("AL9:AL" & lr)
'Tong OVT
Range("AM9").Select
Selection.AutoFill Destination:=Range("AM9:AM" & lr)
'PC MUA CAO DIEM
Range("AN9").Select
Selection.AutoFill Destination:=Range("AN9:AN" & lr)


End With


Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
 
Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
có thể chưa tối giản nhưng dể chấp nhận
Mã: 
Sub Macro1()
Dim Lr As Long, j As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
With ActiveSheet
Lr = .[c65000].End(3).Row
For j = 13 To 16 Step 3
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
For j = 19 To 29 Step 1
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
For j = 33 To 40 Step 1
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
 
Upvote 0
HieuCD đã viết:
có thể chưa tối giản nhưng dể chấp nhận
Mã: 
Sub Macro1()
Dim Lr As Long, j As Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False
With ActiveSheet
Lr = .[c65000].End(3).Row
For j = 13 To 16 Step 3
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
For j = 19 To 29 Step 1
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
For j = 33 To 40 Step 1
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
Next j
End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...

Cảm ơn anh, đúng code em cần, dễ hiểu, có thể tận dụng cho những dạng tương tự.
 
Upvote 0
Cái này bạn có thể dùng 1 vòng lặp thôi. Và dùng IF để lựa chỗ.
Tuy có thể chậm hơn khoảng vài phần triệu giây nhưng tuân thủ được luật tránh lặp lại những đoạn code giống nhau.
Mã: 
For j = 10 to 50
  If (j = 13 Or j = 16) _
  Or (j >= 19 And j <= 29) _
  Or (j >= 33 And j <= 40) _
  Then
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
  End If
Next j
 
Upvote 0
VetMini đã viết:
Cái này bạn có thể dùng 1 vòng lặp thôi. Và dùng IF để lựa chỗ.
Tuy có thể chậm hơn khoảng vài phần triệu giây nhưng tuân thủ được luật tránh lặp lại những đoạn code giống nhau.
Mã: 
For j = 10 to 50
  If (j = 13 Or j = 16) _
  Or (j >= 19 And j <= 29) _
  Or (j >= 33 And j <= 40) _
  Then
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
  End If
Next j
Nhấp chuột vào đây để mở rộng...

Không có căn bản khổ vậy đấy. Bài hôm nay học được nhiều, em cảm ơn mọi người. Kiểu này kiếm đâu lớp VBA online để học mọi người nhỉ.%#^#$

Chào bạn befaint!
 
Upvote 0
VetMini đã viết:
Cái này bạn có thể dùng 1 vòng lặp thôi. Và dùng IF để lựa chỗ.
Tuy có thể chậm hơn khoảng vài phần triệu giây nhưng tuân thủ được luật tránh lặp lại những đoạn code giống nhau.
Mã: 
For j = 10 to 50
  If (j = 13 Or j = 16) _
  Or (j >= 19 And j <= 29) _
  Or (j >= 33 And j <= 40) _
  Then
    Cells(9, j).Copy Range(Cells(9, j), Cells(Lr, j))
  End If
Next j
Nhấp chuột vào đây để mở rộng...

Cho mình hỏi thêm cái trên viết công thức dạng mảng được không?
 
Lần chỉnh sửa cuối:
Upvote 0
Mình sửa lại lệnh như sau

PHP: 
Sub Fill1()Dim lr As LongApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.AskToUpdateLinks = False
With ActiveSheetlr = .[c65000].End(3).Row
For j = 1 To 50  If (j = 1 Or j = 13 Or j = 16) Or (j >= 19 And j <= 29) Or (j >= 33 And j <= 40) Or (j >= 44 And j <= 47) Then    Worksheets("MAU").Cells(9, j).Copy Range(Cells(9, j), Cells(lr, j))  End IfNext j
End WithApplication.AskToUpdateLinks = TrueApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub

Cho mình hỏi làm thế nào dữ nguyên cả định dạng từ sheet Mau?
 
Upvote 0
Mình sửa lại lệnh như sau

PHP: 
Sub Fill1()
Dim lr As LongApplication.ScreenUpdating = FalseApplication.DisplayAlerts = FalseApplication.AskToUpdateLinks = False
With ActiveSheetlr = .[c65000].End(3).Row
For j = 1 To 50  If (j = 1 Or j = 13 Or j = 16) Or (j >= 19 And j <= 29) Or (j >= 33 And j <= 40) Or (j >= 44 And j <= 47) Then    Worksheets("MAU").Cells(9, j).Copy Range(Cells(9, j), Cells(lr, j))  End IfNext j
End WithApplication.AskToUpdateLinks = TrueApplication.DisplayAlerts = TrueApplication.ScreenUpdating = TrueEnd Sub
Cho mình hỏi làm thế nào dữ nguyên cả định dạng từ sheet Mau?
 
Upvote 0
Mình sửa lại lệnh như sau.
Cho mình hỏi làm thế nào dữ nguyên cả định dạng từ sheet Mau? Ngoài ra mình muốn cleaner sạch sẽ những ô sau Ir thì mình thêm câu lệnh gì?

Sub Fill1()Dim lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


With ActiveSheet
lr = .[c65000].End(3).Row


For j = 1 To 50
If (j = 1 Or j = 13 Or j = 16) Or (j >= 19 And j <= 29) Or (j >= 33 And j <= 40) Or (j >= 44 And j <= 47) Then
Worksheets("MAU").Cells(9, j).Copy Range(Cells(9, j), Cells(lr, j))
End If
Next j


End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
Mình sửa lại lệnh như sau.&nbsp;<br>Cho mình hỏi làm thế nào dữ nguyên cả định dạng từ sheet Mau?<br>
<br>
PHP: 
<br>
<br><div>Sub Fill1()</div><div>Dim lr As Long</div><div>Application.ScreenUpdating = False</div><div>Application.DisplayAlerts = False</div><div>Application.AskToUpdateLinks = False</div><div><br></div><div>With ActiveSheet</div><div>lr = .[c65000].End(3).Row</div><div><br></div><div>For j = 1 To 50</div><div>&nbsp; If (j = 1 Or j = 13 Or j = 16) Or (j &gt;= 19 And j &lt;= 29) Or (j &gt;= 33 And j &lt;= 40) Or (j &gt;= 44 And j &lt;= 47) Then</div><div>&nbsp; &nbsp; Worksheets("MAU").Cells(9, j).Copy Range(Cells(9, j), Cells(lr, j))</div><div>&nbsp; End If</div><div>Next j</div><div><br></div><div>End With</div><div>Application.AskToUpdateLinks = True</div><div>Application.DisplayAlerts = True</div><div>Application.ScreenUpdating = True</div><div>End Sub</div><div><br></div>
<br><br>
 
Upvote 0
Mình sửa lại câu lệnh như sau. Và mình muốn định dạng bảng tính giống dòng 9 từ cột 1 đến cột 40 của sheet Mau thì mình thêm câu lệnh nào, sau khi copy công thức từ sheet Mau xong mình muốn chuyển toàn bộ sang dạng giá trị thì làm thế nào? Ngoài ra mình muốn Clear toàn bộ sau dòng Ir cuối cùng thì làm thế nào?

Sub Fill1()Dim lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


With ActiveSheet
lr = .[c65000].End(3).Row


For j = 1 To 50
If (j = 1 Or j = 13 Or j = 16) Or (j >= 19 And j <= 29) Or (j >= 33 And j <= 40) Or (j >= 44 And j <= 47) Then
Worksheets("MAU").Cells(9, j).Copy Range(Cells(9, j), Cells(lr, j))
End If
Next j


End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Lần chỉnh sửa cuối:
Upvote 0
Xin lỗi mọi người, mạng lỗi nên sửa bài thành viết bài mới mà không biết. Diễn đàn mình chẳng có nút xóa bài nhỉ, nhìn bài loạn cả mắt -+*/-+*/.

Mình sửa thành thế này nhưng chạy vẫn quay quay một chút.

Sub Macro2()
Dim lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


With ActiveSheet
lr = .[c65000].End(3).Row
arr = Array(1, 13, 16, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 33, 34, 35, 36, 37, 38, 39, 40, 44, 45, 46, 47)


For j = 0 To UBound(arr) - 1
Cells(9, arr(j)).Copy Range(Cells(9, arr(j)), Cells(lr, arr(j)))
Next j


End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True


End Sub
 
Upvote 0
tueyennhi đã viết:
Xin lỗi mọi người, mạng lỗi nên sửa bài thành viết bài mới mà không biết. Diễn đàn mình chẳng có nút xóa bài nhỉ, nhìn bài loạn cả mắt -+*/-+*/.

Mình sửa thành thế này nhưng chạy vẫn quay quay một chút.

Sub Macro2()
Dim lr As Long
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Application.AskToUpdateLinks = False


With ActiveSheet
lr = .[c65000].End(3).Row
arr = Array(1, 13, 16, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 33, 34, 35, 36, 37, 38, 39, 40, 44, 45, 46, 47)


For j = 0 To UBound(arr) - 1
Cells(9, arr(j)).Copy Range(Cells(9, arr(j)), Cells(lr, arr(j)))
Next j


End With
Application.AskToUpdateLinks = True
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
trong công thức Excel hoặc code VBA, viết ngắn không có nghĩa là sẽ chạy nhanh, rất nhiều trường hợp viết dài và hợp lý sẽ chạy nhanh hơn viết rút ngắn lại. trong bài nầy tốc độ xử lý nhanh nhất là viết theo kiểu ban đầu của bạn (dài nhất), và tốc độ giảm bớt theo thứ tự của các bài vì phải qua các bước trung gian. tùy tình huống mà chọn cách viết như thế nào, trong đó có yếu tố quan trọng là mạch
lạc dể kiểm soát dể viết
 
Upvote 0
Ừm vì mình thấy mọi người vẫn bảo chuyển sang dạng mảng thì nhanh lắm. Chắc code của mình chưa thật sự là mảng.
 
Upvote 0
Code này sai:
With ActiveSheet
lr = .[c65000].End(3).Row
arr = Array(1, 13, 16, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 33, 34, 35, 36, 37, 38, 39, 40, 44, 45, 46, 47)

For j = 0 To UBound(arr) - 1
Cells(9, arr(j)).Copy Range(Cells(9, arr(j)), Cells(lr, arr(j)))
Next j

End With
Nhấp chuột vào đây để mở rộng...
Sai 1:Nếu muốn nối With, thì phải có dấu chấm trước thuộc tính/hàm
Nói cách khác, Cells sẽ chẳng liên quan gì đến With ActiveSheet cả. Muốn liên quan phải là .Cells

Sai 2: Néu bạn dùng UBound(arr) - 1, bạn sẽ bị mất phần tử cuối cùng
Code đúng phải là For j = LBound(Arr) To UBound(Arr)

Tuy nhiên, nếu muón dùng Array làm điểm nhảy thì dùng thẳng code For Each. Chỉ chậm hơn khoảng vài phần triệu giây.

For Each j in Array(1, 13, 16, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 33, 34, 35, 36, 37, 38, 39, 40, 44, 45, 46, 47)
...
Next j

tueyennhi đã viết:
Ừm vì mình thấy mọi người vẫn bảo chuyển sang dạng mảng thì nhanh lắm. Chắc code của mình chưa thật sự là mảng.
Nhấp chuột vào đây để mở rộng...

Bạn hiểu lầm cái ý của "chuyển sang dạng mảng"
Bây giờ bạn tìm link cái câu nói đó, đưa lên đây. Từ đó tôi có thể dẫn giải chỗ hiểu lầm của bạn.
 
Upvote 0
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

SA_DQ
[Xin hỏi] Cách tính số tiền bình quân của tài khoản trong 1 tháng (1 người xem)
Trả lời
11
Đọc
177
SA_DQ
SA_DQ
V
  • Question Question
Tách 1 sheet thành nhiều sheet/file (2 người xem)
Trả lời
3
Đọc
36
HeSanbi
HeSanbi
A
ExTools : Hơn 60 tính năng bổ sung cho Excel (1 người xem)
    • Thích
Trả lời
3
Đọc
9K
mangat060083
M
M
  • Question Question
Tự chèn dòng khi cập nhật dữ liệu từ trang tính khác. (2 người xem)
Trả lời
2
Đọc
26
mtbackup
M
anhtuan1066
  • Question Question
Đọc số thành chữ có phần thập phân
Trả lời
12
Đọc
8K
caocat
C
N
Xin giúp e cách lọc dữ liệu bị trùng
Trả lời
2
Đọc
95
Nguyễn Nal
N
A
  • Question Question
Nhờ anh chị em chú bác giúp em viết code vba thay cho công thức dò tìm và tính
Trả lời
2
Đọc
82
A HOANG 620
A
ongke0711
  • Question Question
Trộn dữ liệu từ Excel sang Word mở rộng (phiên bản ongke0711)
    • Thích
    • Yêu thích
    • Cảm ơn
12 13 14
Trả lời
262
Đọc
28K
toptikibeauty
T
T
tìm ra số tháng mà lượng hàng nhập ban đầu sử dụng hết
    • Cười
Trả lời
3
Đọc
138
minhminh27
minhminh27
nttrung_proneu
Cách giữ công thức khi lọc và tách file (1 người xem)
Trả lời
2
Đọc
73
nttrung_proneu
nttrung_proneu
K
  • Question Question
Code vba đọc QR code file hình ảnh trên CCCD
    • Cười
Trả lời
0
Đọc
87
kingbo.camera
K
Nguyễn Duy Tuân
Phiên bản mới Add-in A-Tools v10 (2024)
    • Thích
2 3
Trả lời
42
Đọc
3K
Nguyễn Duy Tuân
Nguyễn Duy Tuân
H
  • Question Question
Gửi mail hàng loạt với mỗi mail là 1 file PDF đính kèm khác nhau (1 người xem)
Trả lời
1
Đọc
69
minhminh27
minhminh27
B
Làm sao đổi đơn vị B, M này sang hàng đơn vị vậy mọi người?
    • Cười
Trả lời
4
Đọc
73
Bao Nguyen 89
B
C
Tạo hyperlink hàng loạt (1 người xem)
Trả lời
9
Đọc
5K
online.tanphat
O
TrungChinhs
  • Question Question
Hỏi cách làm tròn số trong VBA
Trả lời
9
Đọc
7K
SA_DQ
SA_DQ
dongbhhg
Tìm lương cơ sở theo từng tháng
Trả lời
3
Đọc
93
dongbhhg
dongbhhg
V
Làm mẫu giấy đi đường (công lệnh) bằng Excel
Trả lời
12
Đọc
11K
Gà Công Nghệ
Gà Công Nghệ
N
Thử lập trình XLL add-in bằng C/C++
    • Thích
Trả lời
0
Đọc
104
nguyendang95
N
Tuấn Bụng Bự
tạo QRcode chuyển khoản ngân hàng (1 người xem)
Trả lời
5
Đọc
230
Tuấn Bụng Bự
Tuấn Bụng Bự
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
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom