Add in di chuyển đến ô đầu tiên và ô cuối cùng trong sheet (1 người xem)

[vc_đi chơi]

Em chào các anh/chị trên diễn đàn.
Mong anh/chị giúp em Add in có tác dụng:
- Nếu nhấn tổ hợp phím "Alt+A" thì di chuyển đến ô đầu tiên trong sheet hiện hành có chữa dữ liệu (ô đầu tiên được tính theo ưu tiên chiều từ trên xuống và sau đó mới xét đến theo chiều từ trái sang phải)
- Nếu nhần tổ hợp phím "Alt+Z" thì di chuyển đến Ô cuối cùng Trong Sheet hiện hành có chứa dữ liệu (ô cuối cùng được tính ưu tiên theo chiều từ dưới lên và sau đó mới xét đến theo chiều từ phải sang trái)
Hình mình họa điển hình như dưới, em xin cảm ơn!

 

[Hoàng Tuấn 868]

Em chào các anh/chị trên diễn đàn.
Mong anh/chị giúp em đoạn code Vba có tác dụng:
- Nếu nhấn tổ hợp phím "Alt+A" thì di chuyển đến ô đầu tiên trong sheet hiện hành có chữa dữ liệu (ô đầu tiên được tính theo ưu tiên chiều từ trên xuống và sau đó mới xét đến theo chiều từ trái sang phải)
- Nếu nhần tổ hợp phím "Alt+Z" thì di chuyển đến Ô cuối cùng Trong Sheet hiện hành có chứa dữ liệu (ô cuối cùng được tính ưu tiên theo chiều từ dưới lên và sau đó mới xét đến theo chiều từ phải sang trái)
Hình mình họa điển hình như dưới, em xin cảm ơn!View attachment 308423

Tổ hợp phím Alt+A đã mặc định chức năng khác rồi.

 

[thuytrangbp28]

Hai tổ hợp phím bạn chọn không ổn đâu, vì nó là mặc định của Excel, bạn nên chuyển sang dùng tổ hợp khác. Dùng Application.OnKey trong VBA để gán phím, còn code tìm ô đầu tiên và cuối cùng chứa dữ liệu thì tìm trên diễn đàn (hoặc google) thiếu gì

 

[bebo021999]

Mình gán phím Alt-Shift-A và Alt-Shift-Z
Trong ThisWorkbook, bạn dùng event "Open" để gán khi mở file, và even "BeforeClose" để huỷ gán khi đóng file (Nghĩa là gán phím này chỉ dùng cho file này thôi. Còn nếu muốn gán cho tất cả thì bỏ even "BeforeColse" đi nhé

Option Explicit
Private Sub Workbook_Open()
Application.OnKey "^+A", "timdongdau"
Application.OnKey "^+Z", "timdongcuoi"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^+A"
Application.OnKey "^+Z"
End Sub

Trong Module/Module 1:

Option Explicit
Public Sub timdongdau()
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then cell.Select
End Sub
Public Sub timdongcuoi()
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not cell Is Nothing Then cell.Select
End Sub

Bạn close và sau đó open file rồi test lại nhé

 

[vc_đi chơi]

Mình gán phím Alt-Shift-A và Alt-Shift-Z
Trong ThisWorkbook, bạn dùng event "Open" để gán khi mở file, và even "BeforeClose" để huỷ gán khi đóng file (Nghĩa là gán phím này chỉ dùng cho file này thôi. Còn nếu muốn gán cho tất cả thì bỏ even "BeforeColse" đi nhé

Option Explicit
Private Sub Workbook_Open()
Application.OnKey "^+A", "timdongdau"
Application.OnKey "^+Z", "timdongcuoi"
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.OnKey "^+A"
Application.OnKey "^+Z"
End Sub

Trong Module/Module 1:

Option Explicit
Public Sub timdongdau()
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then cell.Select
End Sub
Public Sub timdongcuoi()
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not cell Is Nothing Then cell.Select
End Sub

Bạn close và sau đó open file rồi test lại nhé

Em cảm ơn anh, em đã chuyển thành Add in và load vào để sử dụng nhưng khi nhấn tổ hợp phím như anh hướng dẫn thì không có tác dụng là sao vậy ạ?

 

[SA_DQ]

Theo file bài 4 thì vầy cũng được nè

Public Sub TimODauTienTrongVungDL()
 Dim Rng As Range, Cls As Range

 Set Rng = ActiveSheet.UsedRange
 MsgBox Rng(0).End(xlToRight).Address
End Sub

 

[bebo021999]

Em cảm ơn anh, em đã chuyển thành Add in và load vào để sử dụng nhưng khi nhấn tổ hợp phím như anh hướng dẫn thì không có tác dụng là sao vậy ạ?

Bạn gửi file xem sao

 

[SA_DQ]

. . . .
Set rng = ActiveSheet.UsedRange
Set cell = rng.Cells.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then cell.Select
. . . .

Set Rng = ActiveSheet.UsedRange
Set Cls =Rng(1).Resize( ,Rng.Columns.Count).Find("*",  SearchOrder:=xlByRows)

 

[vc_đi chơi]

Bạn gửi file xem sao

Em chỉnh chút lại như vậy được rồi ạ! nhưng thấy code vẫn hơi chậm và lác nếu nhiều dữ liệu ạ, cảm ơn anh!
Option Explicit

' Phải đặt các macro trong module thông thường (không phải ThisWorkbook hay Sheet)
Public Sub timdongdau()
On Error Resume Next ' Tránh lỗi nếu không có dữ liệu
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then cell.Select
On Error GoTo 0
End Sub

Public Sub timdongcuoi()
On Error Resume Next ' Tránh lỗi nếu không có dữ liệu
Dim rng As Range, cell As Range
Set rng = ActiveSheet.UsedRange
Set cell = rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
If Not cell Is Nothing Then cell.Select
On Error GoTo 0
End Sub

' Gán phím tắt khi mở workbook
Private Sub Workbook_Open()
Application.OnKey "%+A", "timdongdau" ' Alt+Shift+A
Application.OnKey "%+Z", "timdongcuoi" ' Alt+Shift+Z
End Sub

 

[SA_DQ]

Public Sub timdongdau()
On Error Resume Next ' Tránh lỗi nếu không có dữ liệu
Dim rng As Range, cell As Range
3 Set rng = ActiveSheet.UsedRange
Set cell = rng.Find(What:="*", LookIn:=xlValues, LookAt:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlNext)
If Not cell Is Nothing Then cell.Select
On Error GoTo 0
End Sub

Để tăng tốc code này, mình đề xuất bạn thử thu nhỏ vùng Rng cần tìm kiếm & đó chỉ là hàng đầu của Rng mà thôi;
Sau dòng lệnh mà mình vừa quýnh số 3 nên thêm:

 Set rng =rng(1).Resize( , rng.Columns.Count)
 MsgBox rng.Address 
'. . . .   '

 

[vc_đi chơi]

Để tăng tốc code này, mình đề xuất bạn thử thu nhỏ vùng Rng cần tìm kiếm & đó chỉ là hàng đầu của Rng mà thôi;
Sau dòng lệnh mà mình vừa quýnh số 3 nên thêm:

 Set rng =rng(1).Resize( , rng.Columns.Count)
 MsgBox rng.Address
'. . . .   '

Bác sửa giúp em code hoàn chỉnh với ạ, chứ em chưa biết nhiều về code nên nhờ bác giúp với ạ! đoạn code sau cần sửa như nào vậy bác? em đang dùng code như sau, xin được bác tối ưu giúp để hoạt động ổn định và nhanh hơn:

Sub Odau()
    On Error Resume Next ' B? qua l?i n?u không tìm th?y d? li?u
    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False).Activate
    On Error GoTo 0 ' T?t b? qua l?i
End Sub

Sub Ocuoi()
    On Error Resume Next ' B? qua l?i n?u không tìm th?y d? li?u
    Dim ws As Worksheet
    Set ws = ActiveSheet
    ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, _
        MatchCase:=False).Activate
    On Error GoTo 0 ' T?t b? qua l?i
End Sub
Sub Auto_Open()
    ' Gán phím t?t khi m? file
    Application.OnKey "^+N", "Odau"    ' Ctrl+Shift+N
    Application.OnKey "^+M", "Ocuoi"   ' Ctrl+Shift+M
End Sub

 

[SA_DQ]

Macro đầu bạn chỉ cần thêm 1 dòng lệnh (đầu) ;
[Còn dòng lệnh MsgBox chỉ để kiểm tra lần đầu mà thôi;]

Còn macro thứ 2 thì cần thêm cách xác định dòng cuối của Rng
có thể sẽ là:
Set Rng=Rng(1).Offset(Rng.Rows.Count).Resize(Rng.Columns.Count)