AC giúp em tối ưu VBA với ạ (2 người xem)
- Thread starter Bạn Đoản
- Ngày gửi
Người dùng đang xem chủ đề này
Trần Văn Bình
GTVT
- Tham gia
- 30/7/06
- Bài viết
- 437
- Được thích
- 395
- Nghề nghiệp
- GTVT
Bạn thử dùng sh.Rows("13:" & lr).ClearContents thử xem
le_vis
Thành viên tích cực
- Tham gia
- 23/7/09
- Bài viết
- 1,366
- Được thích
- 853
Chỉ thực hiện xoá dữ liệu thì đặt đoạn code dưới đây vào module2 để thực hiện cho Sheet21
Sub Xoa_BangPhanTic()
Range("A13:V20").Select
Selection.ClearContents
Range("A13").Select
End Sub
Bạn Đoản
Thành viên mới
- Tham gia
- 17/6/24
- Bài viết
- 15
- Được thích
- 1
Phần gộp ô không được định dạng về ban đầu ạ.
HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,898
- Được thích
- 4,718
- Giới tính
- Nam
Bạn muốn xóa mà vẫn undo và redo được có phải không. Cần xử lý XML của vùng dữ liệu, Vùng ô sẽ giữ nguyên định dạng gốc.
Bạn có muốn dùng hàm UDF cho dễ thiết lập hơn không, hàm này hữu dụng có thể tái sử dụng dễ dàng mà không cần viết lại mã VBA, ví dụ:
Bạn có muốn dùng hàm UDF cho dễ thiết lập hơn không, hàm này hữu dụng có thể tái sử dụng dễ dàng mà không cần viết lại mã VBA, ví dụ:
le_vis
Thành viên tích cực
- Tham gia
- 23/7/09
- Bài viết
- 1,366
- Được thích
- 853
Bài #1 bạn ghi :"giúp em mã VBA Botton " Xóa dữ liệu". Em muốn khi chạy giữ nguyên định dạnh kẻ ô như trong ảnh em gửi ạ,..."; Xin hỏi : Tôi làm đã đúng theo Bài #1 bạn yêu cầu chưa ? - Còn muốn gộp vùng Ceel xong khi xoá lại trở về địn dạng ban đầu thì
Cách 1 : Viết lại code
Cách 2 : Làm theo hương dẫn của bạn HeSanbi
Bạn dùng thử đoạn code bên dưới nhé
Sub XoaBang(sh As Worksheet)
Dim lr As Long
Dim rng As Range
' Tim dong cuoi o cot C
lr = sh.Cells(sh.Rows.Count, "C").End(xlUp).Row
' Kiem tra neu khong co du lieu
If lr <= 12 Then Exit Sub
' Xac dinh vung du lieu tu dong 13 den dong cuoi
Set rng = sh.Rows("13:" & lr)
With rng
.UnMerge
.ClearContents
' Tao lai border cho vung
.Borders(xlEdgeTop).LineStyle = xlContinuous
.Borders(xlEdgeBottom).LineStyle = xlContinuous
.Borders(xlEdgeLeft).LineStyle = xlContinuous
.Borders(xlEdgeRight).LineStyle = xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
End Sub
Hy vọng sẽ giúp ích được cho bạn nè
HeSanbi
Nam Nhân✨Hiếu Lễ Nghĩa Trí Tín✨
- Tham gia
- 24/2/13
- Bài viết
- 2,898
- Được thích
- 4,718
- Giới tính
- Nam
Tạm dùng mã này để giữ trạng thái Undo và Redo, tuy nhiên khi Undo phải mất đến 3 lần mới trả về vùng giữ liệu đã xóa
Cần xử lý XML thì mới có được duy nhất một lần Undo là trả về dữ liệu ban đầu đã xóa.
Cần xử lý XML thì mới có được duy nhất một lần Undo là trả về dữ liệu ban đầu đã xóa.
JavaScript:
Sub clearAndUnmergeCells()
On Error Resume Next
Dim rg As Range, rg2 As Range, lr&, r, s$
r = 5: s = "A" & r & ":AN" & r: Set rg = Range(s)
lr = activeSheet.UsedRange.Rows.count - r + 1
If lr > 0 Then
Set rg2 = Selection
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = -4135
rg.Resize(lr).Select
Application.CommandBars.ExecuteMso "UnmergeCells"
Application.CommandBars.ExecuteMso "BordersAll"
Application.CommandBars.ExecuteMso "ClearContents"
rg2.Select
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = -4105
End If
End SubBài viết mới nhất
- Đã giải quyết
- Question
- Question
