Chọn đúng ô vừa thêm sau khi sort. (1 người xem)

[hong loi]

Em chào các Thầy!
Khi thêm một value vào 1 ô, lúc sort value này chạy theo lệnh sort, nếu vùng dử liệu lớn muốn xem value vừa thêm chạy tới vị trí nào thật khó tìm bằng mắt thường.
Em viết code này với mong muốn tự động hiện ngay ô (chọn đúng ô) có value vừa thêm, sau khi sort.

Sub sort()
Set DuLieuO = ActiveCell
DongCuoiB = [B65000].End(xlUp).Row
Sheet1.Range("A1").Resize(DongCuoiB, 2).sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
For i = 1 To 20
    If Cells(i, 2).Value Like DuLieuO.Value Then
        Cells(i, 2).Select
        Exit For
    End If
Next i
End Sub

Nhưng sao nó chọn không đúng

Trong file minh họa value mới thêm là Nguyen Van, sau khi sort nó phải chọn ô có value Nguyen Van, nhưng sao nó lại chọn ngay ô trống.

Xin các Thầy xem và giúp cho nó chọn đúng nhé, em rất cám ơn ạ.

 

[ndu96081631]

Em chào các Thầy!
Khi thêm một value vào 1 ô, lúc sort value này chạy theo lệnh sort, nếu vùng dử liệu lớn muốn xem value vừa thêm chạy tới vị trí nào thật khó tìm bằng mắt thường.
Em viết code này với mong muốn tự động hiện ngay ô (chọn đúng ô) có value vừa thêm, sau khi sort.

Sub sort()
Set DuLieuO = ActiveCell
DongCuoiB = [B65000].End(xlUp).Row
Sheet1.Range("A1").Resize(DongCuoiB, 2).sort Key1:=Range("A1"), Order1:=xlAscending, Key2:=Range("B1") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
For i = 1 To 20
    If Cells(i, 2).Value Like DuLieuO.Value Then
        Cells(i, 2).Select
        Exit For
    End If
Next i
End Sub

Nhưng sao nó chọn không đúng

Trong file minh họa value mới thêm là Nguyen Van, sau khi sort nó phải chọn ô có value Nguyen Van, nhưng sao nó lại chọn ngay ô trống.

Xin các Thầy xem và giúp cho nó chọn đúng nhé, em rất cám ơn ạ.

Sửa thành vầy xem:

Sub sort()
  Dim DuLieuO
  On Error Resume Next
  DuLieuO = ActiveCell.Value
  With Sheet1.Range("A1:B1000")
    .sort .Cells(1, 1), xlAscending, Range("B1"), Header:=xlNo
    .Find(DuLieuO, , xlValues, xlWhole).Activate
  End With
End Sub

 

[huuthang_bd]

Đề phòng trường hợp có nhiều giá trị trùng nhau

Sub Sort()
    On Error Resume Next
    Dim Cll As Range
    With ActiveCell
        .AddComment
        .Comment.Text "This is ActiveCell"
    End With
    With Sheet1.Range("A1:B1000")
        .Sort .Cells(1, 1), xlAscending, Range("B1"), Header:=xlNo
        For Each Cll In .SpecialCells(xlCellTypeComments)
            If .Comment.Text = "This is ActiveCell" Then
                Cll.ClearComments
                Cll.Select
                Exit Sub
            End If
        Next
    End With
End Sub

 

[ndu96081631]

Đề phòng trường hợp có nhiều giá trị trùng nhau

Sub Sort()
    On Error Resume Next
    Dim Cll As Range
    With ActiveCell
        .AddComment
        .Comment.Text "This is ActiveCell"
    End With
    With Sheet1.Range("A1:B1000")
        .Sort .Cells(1, 1), xlAscending, Range("B1"), Header:=xlNo
        For Each Cll In .SpecialCells(xlCellTypeComments)
            If .Comment.Text = "This is ActiveCell" Then
                Cll.ClearComments
                Cll.Select
                Exit Sub
            End If
        Next
    End With
End Sub

Với giải pháp dùng Comments thì cũng có thể Find được mà Thắng

Find("[COLOR=#ff0000]This is ActiveCell[/COLOR]", , [COLOR=#ff0000]xlComments[/COLOR], xlWhole).Activate

 

[hong loi]

Úi dời ơi, cách của hai Thầy đều rất hay ! Vui thật có đến hai Thầy cùng giúp, Code của Thầy ndu96081631 dể hiểu hơn. Em cám ơn hai Thầy lắm lắm.

 

[ndu96081631]

Sửa thành vầy xem:

Sub sort()
  Dim DuLieuO
  On Error Resume Next
  DuLieuO = ActiveCell.Value
  With Sheet1.Range("A1:B1000")
    .sort [COLOR=#ff0000].Cells(1, 1)[/COLOR], xlAscending, [COLOR=#ff0000]Range("B1")[/COLOR], Header:=xlNo
    .Find(DuLieuO, , xlValues, xlWhole).Activate
  End With
End Sub

Viết xong nhìn lại thấy tức cười. Chỗ màu đỏ chẳng "thống nhất tư tưởng" gì cả! Lý ra phải vầy:

Sub sort()
  Dim DuLieuO
  On Error Resume Next
  DuLieuO = ActiveCell.Value
  With Sheet1.Range("A1:B1000")
    .sort [COLOR=#ff0000].Cells(1, 1)[/COLOR], xlAscending, [COLOR=#ff0000].Cells(1, 2)[/COLOR], Header:=xlNo
    .Find(DuLieuO, , xlValues, xlWhole).Activate
  End With
End Sub

Ngoài ra, theo ý tưởng của Thắng dùng Comment thì ta cũng có thể viết:

Sub sort()
 [COLOR=#ff0000] Const DuLieuO = "Danh dau cho nay"[/COLOR]
  On Error Resume Next
  ActiveCell.AddComment DuLieuO
  With Sheet1.Range("A1:B1000")
    .sort .Cells(1, 1), xlAscending, .Cells(1, 2), Header:=xlNo
    [COLOR=#ff0000]With .Find(DuLieuO, , xlComments, xlWhole)
      .Activate
      .ClearComments
    End With[/COLOR]
  End With
End Sub