Xin code tự động Enter khi tab đến 1 cột cố định

Liên hệ QC
Tôi tuân thủ nội quy khi đăng bài
Có
O

ohlexus

Thành viên mới
Tham gia
13/3/12
Bài viết
27
Được thích
6
Hi ACE
nhờ ACE chỉ giùm mình code để tự động Enter (xuống dòng) khi Tab tới 1 ô trong cột bất kì, cụ thể như sau:
Mình nhập liệu ô A1, Tab chuyển B1 nhập liệu .... tới E1 rồi bấm phím Tab tiếp thì nhảy sang F1,
Mình cần là khi tới F1 thì sẽ tự Enter để nhảy về A2 để nhập liệu tiếp
Cảm ơn ACE
Screenshot 2023-12-12 175905.jpg
 
ohlexus đã viết:
Hi ACE
nhờ ACE chỉ giùm mình code để tự động Enter (xuống dòng) khi Tab tới 1 ô trong cột bất kì, cụ thể như sau:
Mình nhập liệu ô A1, Tab chuyển B1 nhập liệu .... tới E1 rồi bấm phím Tab tiếp thì nhảy sang F1,
Mình cần là khi tới F1 thì sẽ tự Enter để nhảy về A2 để nhập liệu tiếp
Cảm ơn ACE
View attachment 297510
Nhấp chuột vào đây để mở rộng...

1. Thử đặt ô A1. Nhấn tab 4 lần rồi enter xem thế nào.
2. Thử bôi đen A1:E2. Giữ phím tab 30s xem thế nào.
3. Khác...
 
Bạn có thể thử chép mã dưới đây vào mã trang tính, để thực hiện

JavaScript: 
Option Explicit

Private Sub Worksheet_Change(ByVal t As Range)
  If CellSingle(t) = 0 Then Exit Sub
  On Error Resume Next
  Dim r As Range
  Set r = [E1]
  If r.Column = t.Column Then
    Application.EnableEvents = False
    cells(t.Row + t(1, 0).MergeArea.Rows.Count, 1).Select:
    Application.EnableEvents = True
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal t As Range)
  On Error Resume Next
  Static o As Range
  Dim r As Range, c1%, c2%
  Set r = [E1]
  If CellSingle(t) = 0 Then Set o = Nothing: Exit Sub
  c1 = r.Column: c2 = t.Column
  If o Is Nothing Then
    If c2 = c1 Then Set o = t
  Else
    If c2 = c1 + 1 And t.Row = o.Row Then
      Application.EnableEvents = False
      cells(o.Row + o.Rows.Count, 1).Select:
      Application.EnableEvents = True
    End If
    Set o = Nothing
  End If
End Sub

Private Function CellSingle(ParamArray cells()) As Long
  On Error Resume Next
  Dim u%, i%, c&, r&, cs&, rs&: u = UBound(cells)
  With cells(0)
    CellSingle = .MergeCells
    r = .Row: c = .Column: rs = .Rows.Count: cs = .Columns.Count
    If CellSingle = 0 Then CellSingle = (Err = 0) And (cs = -(rs = 1))
    If CellSingle Then
      rs = r + rs: cs = c + cs
      For i = 1 To u
        With cells(i)
          If (c = .Column) And (r >= .Row) And (rs <= (.Row + .Rows.Count)) Then CellSingle = i: Exit For
        End With
      Next
    End If
  End With
  Err.Clear
End Function
 
cantl đã viết:
1. Thử đặt ô A1. Nhấn tab 4 lần rồi enter xem thế nào.
2. Thử bôi đen A1:E2. Giữ phím tab 30s xem thế nào.
3. Khác...
Nhấp chuột vào đây để mở rộng...
Ak hiện tại thì mình đang thực hiện như mục 1 thì là vẫn được theo ý mình cần, là bấm phím Enter thì sẽ nhảy xuống A2 để nhập liệu tiếp. Nhưng vì lặp lại rất nhiều lần nên mình muốn nó sẽ tự Enter khi tab tới cột F ấy bạn
 
Ô F1 bạn có nhập gì không?
 
HeSanbi đã viết:
Bạn có thể thử chép mã dưới đây vào mã trang tính, để thực hiện

JavaScript: 
Option Explicit

Private Sub Worksheet_Change(ByVal t As Range)
  If CellSingle(t) = 0 Then Exit Sub
  On Error Resume Next
  Dim r As Range
  Set r = [E1]
  If r.Column = t.Column Then
    Application.EnableEvents = False
    cells(t.Row + t(1, 0).MergeArea.Rows.Count, 1).Select:
    Application.EnableEvents = True
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal t As Range)
  On Error Resume Next
  Static o As Range
  Dim r As Range, c1%, c2%
  Set r = [E1]
  If CellSingle(t) = 0 Then Set o = Nothing: Exit Sub
  c1 = r.Column: c2 = t.Column
  If o Is Nothing Then
    If c2 = c1 Then Set o = t
  Else
    If c2 = c1 + 1 And t.Row = o.Row Then
      Application.EnableEvents = False
      cells(o.Row + o.Rows.Count, 1).Select:
      Application.EnableEvents = True
    End If
    Set o = Nothing
  End If
End Sub

Private Function CellSingle(ParamArray cells()) As Long
  On Error Resume Next
  Dim u%, i%, c&, r&, cs&, rs&: u = UBound(cells)
  With cells(0)
    CellSingle = .MergeCells
    r = .Row: c = .Column: rs = .Rows.Count: cs = .Columns.Count
    If CellSingle = 0 Then CellSingle = (Err = 0) And (cs = -(rs = 1))
    If CellSingle Then
      rs = r + rs: cs = c + cs
      For i = 1 To u
        With cells(i)
          If (c = .Column) And (r >= .Row) And (rs <= (.Row + .Rows.Count)) Then CellSingle = i: Exit For
        End With
      Next
    End If
  End With
  Err.Clear
End Function
Nhấp chuột vào đây để mở rộng...
Thank bạn, mình copy vào và thử nhưng ko thấy được bạn à.
Với lại là nếu mình cần sửa ở cột khác thì sẽ thay (E1) kia là vị trí cần sửa đúng ko bạn,
Các số liệu từ A1 đến E1 là đc nhập tự động theo hình thức tab sang ngang, sau đo mình phải Enter để nó nhảy xuống A2, và cứ tiếp tục như thế đến A....
Bài đã được tự động gộp:

mrfeed87 đã viết:
Ô F1 bạn có nhập gì không?
Nhấp chuột vào đây để mở rộng...
Ko bạn ơi, là sau khi nhập tự động đến E1 thì nó tự tab nhảy sang F1
 
ohlexus đã viết:
Thank bạn, mình copy vào và thử nhưng ko thấy được bạn à.
Với lại là nếu mình cần sửa ở cột khác thì sẽ thay (E1) kia là vị trí cần sửa đúng ko bạn,
Các số liệu từ A1 đến E1 là đc nhập tự động theo hình thức tab sang ngang, sau đo mình phải Enter để nó nhảy xuống A2, và cứ tiếp tục như thế đến A....
Bài đã được tự động gộp:


Ko bạn ơi, là sau khi nhập tự động đến E1 thì nó tự tab nhảy sang F1
Nhấp chuột vào đây để mở rộng...
Nghĩa là sau khi bạn nhập xong E1 bạn muốn nó nhảy xuống luôn A2 đúng không?
 
@ohlexus Bạn nhấn chuột phải vào tên trang tính, chọn View Code (Xem mã) và dán mã vào
 
mrfeed87 đã viết:
Nghĩa là sau khi bạn nhập xong E1 bạn muốn nó nhảy xuống luôn A2 đúng không?
Nhấp chuột vào đây để mở rộng...
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
If Not Intersect(Target, Range(Cells(1, 1), Cells(lr, 5))) Is Nothing Then
Call AutoSelectedCell
End If
End Sub
Sub AutoSelectedCell()
Application.ScreenUpdating = False
Dim r As Range, activeRange As Range
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row 'Tim dong cuoi
Set activeRange = Range(Cells(lr, 1), Cells(lr, 4)) 'chon vung muon dich sang 1 cot
For Each r In activeRange
If r <> "" Then r.Offset(0, 1).Select
Next
If Cells(lr, 5) <> "" Then 'tu xuong cot A cuoi cung sau khi nhap xong du lieu o cot E
Cells(lr, 5).Offset(1, -4).Select
End If
Application.ScreenUpdating = True
End Sub

Bạn nhấn chuột phải vào cái chỗ hay đổi tên Sheet ở Sheet bạn muốn dùng code, nháy chuột phải chọn ViewCode và dán đoạn code trên vào
Sau khi dán mỗi lần nhập xong bạn chỉ cần ấn enter nó sẽ tự chạy sang không cần ấn Tab và đến cột E nó sẽ tự chạy xuống
 

File đính kèm

  • Capture.PNG
    Capture.PNG
    9.8 KB · Đọc: 5
ohlexus đã viết:
Ak hiện tại thì mình đang thực hiện như mục 1 thì là vẫn được theo ý mình cần, là bấm phím Enter thì sẽ nhảy xuống A2 để nhập liệu tiếp. Nhưng vì lặp lại rất nhiều lần nên mình muốn nó sẽ tự Enter khi tab tới cột F ấy bạn
Nhấp chuột vào đây để mở rộng...
3. Khác:
Mã: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim VungCam As Range
Set VungCam = [F:XFD] 'Muèn cÊm cét nµo th× cø nhËp vµo ®©y nhÐ
If Not Intersect(Target, VungCam) Is Nothing Then
cells(Target.Row + 1, 1).Select
End If
End Sub

Code của Hesanbi ngon quá trời mà không biết cách dùng thì xin code làm gì nhẩy?

HeSanbi đã viết:
mã
Nhấp chuột vào đây để mở rộng...
Bạn có thể giải thích ưu điểm khi code dài như vậy không? Vì yêu cầu này thì không đến mức phải nhiều kỹ thuật code như vậy?
Tớ không dịch được code nên không biết trong code lưu ý đến những trường hợp nào.
 
mrfeed87 đã viết:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
If Not Intersect(Target, Range(Cells(1, 1), Cells(lr, 5))) Is Nothing Then
Call AutoSelectedCell
End If
End Sub
Sub AutoSelectedCell()
Application.ScreenUpdating = False
Dim r As Range, activeRange As Range
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row 'Tim dong cuoi
Set activeRange = Range(Cells(lr, 1), Cells(lr, 4)) 'chon vung muon dich sang 1 cot
For Each r In activeRange
If r <> "" Then r.Offset(0, 1).Select
Next
If Cells(lr, 5) <> "" Then 'tu xuong cot A cuoi cung sau khi nhap xong du lieu o cot E
Cells(lr, 5).Offset(1, -4).Select
End If
Application.ScreenUpdating = True
End Sub

Bạn nhấn chuột phải vào cái chỗ hay đổi tên Sheet ở Sheet bạn muốn dùng code, nháy chuột phải chọn ViewCode và dán đoạn code trên vào
Sau khi dán mỗi lần nhập xong bạn chỉ cần ấn enter nó sẽ tự chạy sang không cần ấn Tab và đến cột E nó sẽ tự chạy xuống
Nhấp chuột vào đây để mở rộng...
chỗ tab sang là nó tự động của phần mềm rồi ấy bạn, vướng mỗi chỗ Enter thôi
Bài đã được tự động gộp:

cantl đã viết:
Code của Hesanbi ngon quá trời mà không biết cách dùng thì xin code làm gì nhẩy?
Nhấp chuột vào đây để mở rộng...
Là mình dán code xong ra nhập liệu từ A đến E, tad sang F mà ko thấy tự Enter bạn ui, chắc mình sai đoạn nào ấy
 
ohlexus đã viết:
chỗ tab sang là nó tự động của phần mềm rồi ấy bạn, vướng mỗi chỗ Enter thôi
Bài đã được tự động gộp:


Là mình dán code xong ra nhập liệu từ A đến E, tad sang F mà ko thấy tự Enter bạn ui, chắc mình sai đoạn nào ấy
Nhấp chuột vào đây để mở rộng...
Ấn luôn Enter nó nó tự nhảy, không cần ấn Tab
 
ohlexus đã viết:
Hi ACE
nhờ ACE chỉ giùm mình code để tự động Enter (xuống dòng) khi Tab tới 1 ô trong cột bất kì, cụ thể như sau:
Mình nhập liệu ô A1, Tab chuyển B1 nhập liệu .... tới E1 rồi bấm phím Tab tiếp thì nhảy sang F1,
Mình cần là khi tới F1 thì sẽ tự Enter để nhảy về A2 để nhập liệu tiếp
Cảm ơn ACE
View attachment 297510
Nhấp chuột vào đây để mở rộng...
Ẩn tất cả các cột từ F... đến hết, là được
 
mrfeed87 đã viết:
Ấn luôn Enter nó nó tự nhảy, không cần ấn Tab
Nhấp chuột vào đây để mở rộng...
vừa thử lại thì lại được ngon đúng như ý rồi bạn ơi, nãy ko biết sai sót gì,
Bài đã được tự động gộp:

HeSanbi đã viết:
Bạn có thể thử chép mã dưới đây vào mã trang tính, để thực hiện

JavaScript: 
Option Explicit

Private Sub Worksheet_Change(ByVal t As Range)
  If CellSingle(t) = 0 Then Exit Sub
  On Error Resume Next
  Dim r As Range
  Set r = [E1]
  If r.Column = t.Column Then
    Application.EnableEvents = False
    cells(t.Row + t(1, 0).MergeArea.Rows.Count, 1).Select:
    Application.EnableEvents = True
  End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal t As Range)
  On Error Resume Next
  Static o As Range
  Dim r As Range, c1%, c2%
  Set r = [E1]
  If CellSingle(t) = 0 Then Set o = Nothing: Exit Sub
  c1 = r.Column: c2 = t.Column
  If o Is Nothing Then
    If c2 = c1 Then Set o = t
  Else
    If c2 = c1 + 1 And t.Row = o.Row Then
      Application.EnableEvents = False
      cells(o.Row + o.Rows.Count, 1).Select:
      Application.EnableEvents = True
    End If
    Set o = Nothing
  End If
End Sub

Private Function CellSingle(ParamArray cells()) As Long
  On Error Resume Next
  Dim u%, i%, c&, r&, cs&, rs&: u = UBound(cells)
  With cells(0)
    CellSingle = .MergeCells
    r = .Row: c = .Column: rs = .Rows.Count: cs = .Columns.Count
    If CellSingle = 0 Then CellSingle = (Err = 0) And (cs = -(rs = 1))
    If CellSingle Then
      rs = r + rs: cs = c + cs
      For i = 1 To u
        With cells(i)
          If (c = .Column) And (r >= .Row) And (rs <= (.Row + .Rows.Count)) Then CellSingle = i: Exit For
        End With
      Next
    End If
  End With
  Err.Clear
End Function
Nhấp chuột vào đây để mở rộng...
Chạy ngon lắm bạn nhé, cảm ơn bạn
Nếu mình muốn sử dụng ở ô khác (cột khác) thì chỉ việc thay đoạn
Set r = [E1]
Nhấp chuột vào đây để mở rộng...
bằng vị trí ô (cột) cần tự động Enter đúng ko bạn
Bài đã được tự động gộp:

HeSanbi đã viết:
@ohlexus Bạn nhấn chuột phải vào tên trang tính, chọn View Code (Xem mã) và dán mã vào
Nhấp chuột vào đây để mở rộng...
trường hợp mình muốn sử dụng ở vị trí ở các cột khác thì thay đổi ntn để sử dụng được bạn nhỉ,
Chỗ
Set r = [E1]
Nhấp chuột vào đây để mở rộng...
thì mình nhìn thì hình dung là sẽ thay bằng vị trí sẽ tự động Enter, như trường hợp này thì nó sẽ Enter về cột A, Mình muốn cột khác thì chỉnh đoạn code nào bạn nhỉ, Cảm ơn bạn
Ví dụ mình cần sử dụng ở cột  đến AE, thì E mình thay bằng AE thì tự Enter rồi, mà lại enter về A, giờ mình cần enter về AA
1702440669331.png
 
Lần chỉnh sửa cuối:
Tính năng tab của Excel thì khi mình Enter nó sẽ về vị trí ô ở ngay dưới ô đặt con trỏ ban đầu.
Trước đây mình đặt chỏ ở AA, sau khi nhập tới AE, phần mềm sẽ tab sang AF, mình Enter là nó sẽ nhảy xuống ô AA+1
 
mrfeed87 đã viết:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row
If Not Intersect(Target, Range(Cells(1, 1), Cells(lr, 5))) Is Nothing Then
Call AutoSelectedCell
End If
End Sub
Sub AutoSelectedCell()
Application.ScreenUpdating = False
Dim r As Range, activeRange As Range
Dim lr As Long
lr = Cells(Rows.Count, 1).End(xlUp).Row 'Tim dong cuoi
Set activeRange = Range(Cells(lr, 1), Cells(lr, 4)) 'chon vung muon dich sang 1 cot
For Each r In activeRange
If r <> "" Then r.Offset(0, 1).Select
Next
If Cells(lr, 5) <> "" Then 'tu xuong cot A cuoi cung sau khi nhap xong du lieu o cot E
Cells(lr, 5).Offset(1, -4).Select
End If
Application.ScreenUpdating = True
End Sub

Bạn nhấn chuột phải vào cái chỗ hay đổi tên Sheet ở Sheet bạn muốn dùng code, nháy chuột phải chọn ViewCode và dán đoạn code trên vào
Sau khi dán mỗi lần nhập xong bạn chỉ cần ấn enter nó sẽ tự chạy sang không cần ấn Tab và đến cột E nó sẽ tự chạy xuống
Nhấp chuột vào đây để mở rộng...
Hi bạn, mình test thứ có chạy, mà giờ mình cần ở vị trí khác, ví dụ từ AA đến AF thì phải sửa ntn bạn, mình mò mà ko biết nhiều nên ko sửa được
 
@ohlexus
cells(..., 1).Select
Sửa ở chỗ số 1 thành [AA1].Column
 
cantl đã viết:
3. Khác:
Mã: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim VungCam As Range
Set VungCam = [F:XFD] 'Muèn cÊm cét nµo th× cø nhËp vµo ®©y nhÐ
If Not Intersect(Target, VungCam) Is Nothing Then
cells(Target.Row + 1, 1).Select
End If
End Sub
Nhấp chuột vào đây để mở rộng...
Bạn ơi, Cái này chạy OK lắm bạn, nhưng mình bị phát sinh 1 vấn đề như sau nhờ bạn giúp,
Ví dụ lúc đầu mình nhập liệu từ B1 rồi tab sang C1, mình chỉnh như sau
Set VungCam = [D:XFD] và cells(Target.Row + 1, 2).Select
Nhấp chuột vào đây để mở rộng...
thì dữ liệu cứ từ B sang C rồi lại Enter xuống dòng B sau đó, cái này rất OKa,
Nhưng giai đoạn sau mình cần nhập liệu ở cột D theo cơ chế D1, D2, D3 (tức là cứ Enter rồi nhập) thì với code trên nó ko cho chỉ con trỏ và vùng cấm nên lại ko dùng đc, phải chỉnh ntn để khi chủ động trỏ chuột vào D thì vẫn nhận nhập liệu như các code của mấy bạn kia ko bạn
Bài đã được tự động gộp:

HeSanbi đã viết:
@ohlexus
cells(..., 1).Select
Sửa ở chỗ số 1 thành [AA1].Column
Nhấp chuột vào đây để mở rộng...
Mã: 
cells(t.Row + t(1, 0).MergeArea.Rows.Count, 1).Select:

      cells(o.Row + o.Rows.Count, 1).Select:
Thay cả ở 2 đoạn này phải ko bạn
 
Lần chỉnh sửa cuối:
ohlexus đã viết:
thì dữ liệu cứ từ B sang C rồi lại Enter xuống dòng B sau đó, cái này rất OKa,
Nhưng giai đoạn sau mình cần nhập liệu ở cột D theo cơ chế D1, D2, D3 (tức là cứ Enter rồi nhập)
Nhấp chuột vào đây để mở rộng...
Ối zời ơi, thế thì phức tạp quá. Để tớ nghĩ đã. Từ cột F rồi nhảy AA, rồi nhảy lam ba đa thì căng đây.
 
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

hung2412
  • Question
Có Code VBA nào để chỉnh Short date trong Control Panel không? (Ví dụ: Chỉnh dd/mm/yy => dd/mm/yyyy)
Trả lời
1
Đọc
3
BuiQuangThuan
B
S
  • Question
Không lấy đủ dữ liệu bằng kết nối ADO
Trả lời
4
Đọc
123
shnhatha221108
S
H
Nhờ mấy anh chị giúp về công thức dò tìm kiếm và trả về kết quả ngày tháng
Trả lời
2
Đọc
27
SA_DQ
SA_DQ
Bich2B
lỗi định dạng ngày không đọc được công thức excel
Trả lời
7
Đọc
124
tijikama
tijikama
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2
Trả lời
35
Đọc
367
LuuAnh980
LuuAnh980
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

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

Back
Top Bottom