Code next qua cell kế tiếp khi cell đang chọn có dữ liệu (1 người xem)

[phuoclocvl]

Chào GPE
có thể giúp em viết 1 code như thế này được không em dùng vòng lập mà không được, vì em cũng dốt nên đành potay

em có 1 file excel. giả sử em đang chọn cell A1 nếu cell này có data thì sẽ next sang cell B1 .... cell D1. nhưng nếu cell D1 có data thì lại trở về cell A2 và tiếp tục như vậy.
Pro nào giúp em với.
Cảm ơn

 

[phuoclocvl]

Giúp giùm em đi huhu

 

[nghiaphuc]

Chào GPE
có thể giúp em viết 1 code như thế này được không em dùng vòng lập mà không được, vì em cũng dốt nên đành potay

em có 1 file excel. giả sử em đang chọn cell A1 nếu cell này có data thì sẽ next sang cell B1 .... cell D1. nhưng nếu cell D1 có data thì lại trở về cell A2 và tiếp tục như vậy.
Pro nào giúp em với.
Cảm ơn

Bạn thử code sau xem có đúng ý không nhé:
[GPECODE=vb]Sub Test()
Dim Cll As Range
For Each Cll In Sheet1.[A1100]
If IsEmpty(Cll) Then
'Làm gì đó
Exit For
End If
Next
End Sub[/GPECODE]

 

[phongkiemtinh]

Bạn thử code sau xem có đúng ý không nhé:
[GPECODE=vb]Sub Test()
Dim Cll As Range
For Each Cll In Sheet1.[A1100]
If IsEmpty(Cll) Then
'Làm gì đó
Exit For
End If
Next
End Sub[/GPECODE]

mình thử mà không được bạn, mình giả sử mình làm cho sheet 4 với code:
Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In Sheet4.[A1100]
If IsEmpty(Cll) Then
'Làm gì dó
Exit For
End If
Next
End Sub
vậy mà nhập bình thường ko thấy code có ý nghĩa gì ca????

 

[Let'GâuGâu]

mình thử mà không được bạn, mình giả sử mình làm cho sheet 4 với code:
Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In Sheet4.[A1100]
If IsEmpty(Cll) Then
'Làm gì dó
Exit For
End If
Next
End Sub
vậy mà nhập bình thường ko thấy code có ý nghĩa gì ca????

bạn có kêu nó làm cái gì đâu mà kếu có gì
bạn thử thay 'Làm gì dó
bằng Msgbox "lam gi do"
thử xem

 

[phongkiemtinh]

Chào GPE
có thể giúp em viết 1 code như thế này được không em dùng vòng lập mà không được, vì em cũng dốt nên đành potay

em có 1 file excel. giả sử em đang chọn cell A1 nếu cell này có data thì sẽ next sang cell B1 .... cell D1. nhưng nếu cell D1 có data thì lại trở về cell A2 và tiếp tục như vậy.
Pro nào giúp em với.
Cảm ơn

THeo yêu cầu muốn làm giống yêu cầu bạn này mà, thử theo cách a chỉ cũng không được. Phải tự động chuyển qua theo yêu cầu chứ.

 

[nghiaphuc]

mình thử mà không được bạn, mình giả sử mình làm cho sheet 4 với code:
Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In Sheet4.[A1100]
If IsEmpty(Cll) Then
'Làm gì dó
Exit For
End If
Next
End Sub
vậy mà nhập bình thường ko thấy code có ý nghĩa gì ca????

Bạn thử dùng code này cho sheet cần áp dụng xem:
[GPECODE=vb]Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In [A1100]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
End Sub[/GPECODE]
Bạn sẽ thấy mỗi khi chọn sheet thì ô trống đầu tiên trong vùng A1100 (tính từ trái sang phải, từ trên xuống dưới) sẽ được chọn.

 

[phongkiemtinh]

Bạn thử dùng code này cho sheet cần áp dụng xem:
[GPECODE=vb]Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In [A1100]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
End Sub[/GPECODE]
Bạn sẽ thấy mỗi khi chọn sheet thì ô trống đầu tiên trong vùng A1100 (tính từ trái sang phải, từ trên xuống dưới) sẽ được chọn.

Hay đúng yêu cầu rồi, cảm ơn bác Nghĩa Phúc.

 

[phanminhphuong]

Chào GPE
có thể giúp em viết 1 code như thế này được không em dùng vòng lập mà không được, vì em cũng dốt nên đành potay

em có 1 file excel. giả sử em đang chọn cell A1 nếu cell này có data thì sẽ next sang cell B1 .... cell D1. nhưng nếu cell D1 có data thì lại trở về cell A2 và tiếp tục như vậy.
Pro nào giúp em với.
Cảm ơn

Bạn có làm được bằng tay không? làm được sao không Record Macro và chỉnh sửa? (đối với VBA, thực hiện được = tay thì có thể viết Code cho các thao tác đó được thôi). Đó cũng là 1 cách học tốt mà!
chẳng hạn với bài này:

[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]

Dim myRange

If Intersect(Target, Range("A1:D100")) Is Nothing Then Exit Sub
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub

Set myRange = Union(Range(Target, "D" & Target.Row), Range("A" & Target.Row + 1 & ":D100"))
    myRange.Find(What:="", After:=Target).Select

End Sub

Vừa xem lại thì mình chưa hiểu yêu cầu này phục vụ cho mục đích gì? VD có thể bạn tìm ô trống đầu tiên sau ô bạn chọn để thêm data: Ô A1 có dữ liệu => chọn A1 mà B1 trống => Code sẽ chạy & chọn B1 => bạn thêm dữ liệu vào B1 sau đó chọn ô khác chẳng hạn. Vậy dữ liệu B1 sai thì sau đó làm sao chọn lại được ô B1 để mà sửa đây? tốt nhất là ko nên sử dụng code Worksheet_SelectionChange mà tạo riêng 1 sub lúc nào cần thì chạy có lẽ sẽ hợp lý hơn.

 

[phongkiemtinh]

Bạn thử dùng code này cho sheet cần áp dụng xem:
[GPECODE=vb]Private Sub Worksheet_Activate()
Dim Cll As Range
For Each Cll In [A1100]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
End Sub[/GPECODE]
Bạn sẽ thấy mỗi khi chọn sheet thì ô trống đầu tiên trong vùng A1100 (tính từ trái sang phải, từ trên xuống dưới) sẽ được chọn.

E sử dụng code để mỗi lần nhập liệu vào cell xong nhấn enter sẽ nhảy qua cell kế tiếp để nhập, nếu nhập 1 sheet thì ko sao nhưng xảy ra lỗi khi nhập nhiều sheet cùng cấu trúc cùng lúc bằng cách group các sheet nhập cùng lúc. lỗi báo ở dòng màu xanh, bac xem dùm e nhé.


Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

' "code tu dong chuyen con chuot sang cell o trong sau khi nhap data"

Dim Cll As Range
For Each Cll In [D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub

 

[phongkiemtinh]

Không có ai giải quyết được vần đề này à.hic chán thật....

 

[nghiaphuc]

E sử dụng code để mỗi lần nhập liệu vào cell xong nhấn enter sẽ nhảy qua cell kế tiếp để nhập, nếu nhập 1 sheet thì ko sao nhưng xảy ra lỗi khi nhập nhiều sheet cùng cấu trúc cùng lúc bằng cách group các sheet nhập cùng lúc. lỗi báo ở dòng màu xanh, bac xem dùm e nhé.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

' "code tu dong chuyen con chuot sang cell o trong sau khi nhap data"

Dim Cll As Range
For Each Cll In [D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub

Bạn thử sửa lại code một chút và áp dụng cho đối tượng ThisWorkbook, có vẻ ổn đấy:
[GPECODE=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
' "code tu dong chuyen con chuot sang cell o trong sau khi nhap data"
Dim Cll As Range
For Each Cll In [D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

 

[nghiaphuc]

Bạn thử sửa lại code một chút và áp dụng cho đối tượng ThisWorkbook, có vẻ ổn đấy:
[GPECODE=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
' "code tu dong chuyen con chuot sang cell o trong sau khi nhap data"
Dim Cll As Range
For Each Cll In [D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

Bạn nhớ bỏ các Sub Worksheet_Change của các sheet đi nhé.

Ayza, nhầm một chút, thay vì nhấn Sửa bài viết thì mình lại nhấn Trả lời với trích dẫn. Nhờ Smod gộp 2 bài này và xóa dòng này giùm em. Xin cảm ơn!

 

[phongkiemtinh]

Bạn thử sửa lại code một chút và áp dụng cho đối tượng ThisWorkbook, có vẻ ổn đấy:
[GPECODE=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.ScreenUpdating = False
' "code tu dong chuyen con chuot sang cell o trong sau khi nhap data"
Dim Cll As Range
For Each Cll In [D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]

Bác Nghĩa Phúc ơi, nhưng nếu chuyển sang cho workbook thì ảnh hưởng toàn sheet trong workbook. E chỉ muốn ảnh hưởng của code với các vùng [D3:M1000] ở 1 số sheet thôi, còn các sheet khác thì có ảnh hưởng ở vùng khác.
Nếu hiệu ứng tất cả các sheet thì khi nhập nó nhảy ở 1 số vùng của sheet kia khó chịu lắm bác. bác xem có cách nào chỉ có tác dụng trên sheet chỉ định không.Cảm ơn bác

 

[nghiaphuc]

Bác Nghĩa Phúc ơi, nhưng nếu chuyển sang cho workbook thì ảnh hưởng toàn sheet trong workbook. E chỉ muốn ảnh hưởng của code với các vùng [D3:M1000] ở 1 số sheet thôi, còn các sheet khác thì có ảnh hưởng ở vùng khác.
Nếu hiệu ứng tất cả các sheet thì khi nhập nó nhảy ở 1 số vùng của sheet kia khó chịu lắm bác. bác xem có cách nào chỉ có tác dụng trên sheet chỉ định không.Cảm ơn bác

Sự kiện này có một tham số là Sh đấy, bạn có thể dựa vào Sh.Name để quyết định chạy code hay không. Chẳng hạn bạn chỉ áp dụng cho Sheet1 hoặc Sheet3 thì code thế này:
[GPECODE=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cll As Range
Const ApplyToSheet As String = ".Sheet1.Sheet3."
Application.ScreenUpdating = False
If InStr(1, ApplyToSheet, "." & Sh.Name & ".", 1) = 0 Then Exit Sub
For Each Cll In Sh.[D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]
Trong code trên, dòng lệnh thứ 5 chính là kiểm tra điều kiện sheet Sh này có phải là sheet cần áp dụng code không, nếu không thì Exit Sub.
Muốn áp dụng cho nhiều sheet hơn nữa thì bạn chỉ cần thêm tên sheet vào hằng ApplyToSheet là được. Lưu ý rằng ở đây tôi "khóa" tên sheet bởi 2 dấu chấm ở 2 đầu để phòng trường hợp tên sheet này chứa trong tên sheet kia, chẳng hạn "Thang 1" và "Thang 12"

 

[phongkiemtinh]

Sự kiện này có một tham số là Sh đấy, bạn có thể dựa vào Sh.Name để quyết định chạy code hay không. Chẳng hạn bạn chỉ áp dụng cho Sheet1 hoặc Sheet3 thì code thế này:
[GPECODE=vb]Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Cll As Range
Const ApplyToSheet As String = ".Sheet1.Sheet3."
Application.ScreenUpdating = False
If InStr(1, ApplyToSheet, "." & Sh.Name & ".", 1) = 0 Then Exit Sub
For Each Cll In Sh.[D3:M1000]
If IsEmpty(Cll) Then
Cll.Select
Exit For
End If
Next
Application.ScreenUpdating = True
End Sub[/GPECODE]
Trong code trên, dòng lệnh thứ 5 chính là kiểm tra điều kiện sheet Sh này có phải là sheet cần áp dụng code không, nếu không thì Exit Sub.
Muốn áp dụng cho nhiều sheet hơn nữa thì bạn chỉ cần thêm tên sheet vào hằng ApplyToSheet là được. Lưu ý rằng ở đây tôi "khóa" tên sheet bởi 2 dấu chấm ở 2 đầu để phòng trường hợp tên sheet này chứa trong tên sheet kia, chẳng hạn "Thang 1" và "Thang 12"

Mà sao bác ơi, Nhập dữ liệu ngoài vùng [D3:M1000] thì code không có tác dụng chứ, sao nhập ngoài vùng trên nó cũng nhảy vào trong vùng. e muôn ngoài vùng này thì không có tác dụng.

 

[nghiaphuc]

Mà sao bác ơi, Nhập dữ liệu ngoài vùng [D3:M1000] thì code không có tác dụng chứ, sao nhập ngoài vùng trên nó cũng nhảy vào trong vùng. e muôn ngoài vùng này thì không có tác dụng.

Chuyện này thì dễ ẹc ấy mà. Bạn chỉ cần thêm câu lệnh If Intersect(Target, Sh.[D3:M1000]) Is Nothing Then Exit Sub vào trước vòng lặp For là được.

 

[phongkiemtinh]

Chuyện này thì dễ ẹc ấy mà. Bạn chỉ cần thêm câu lệnh If Intersect(Target, Sh.[D3:M1000]) Is Nothing Then Exit Sub vào trước vòng lặp For là được.

Bác xem dùm e sao file e cho vào nó không hoạt động được, e làm thử với file trong mới thì chạy được mà chèn vào file thì lỗi không chạy. Pass unlock sheet là :GPE

 

[nghiaphuc]

Bác xem dùm e sao file e cho vào nó không hoạt động được, e làm thử với file trong mới thì chạy được mà chèn vào file thì lỗi không chạy. Pass unlock sheet là :GPE

Có lẽ do mỗi sheet bạn đã đặt một cái sub Worksheet_Change rồi, tại đối tượng ThisWorkbook, bạn còn dùng thêm sub Workbook_SheetChange nữa. Và khi có sự thay đổi trên sheet thì 2 anh chàng này "đá" nhau chăng?

 

[phongkiemtinh]

Có lẽ do mỗi sheet bạn đã đặt một cái sub Worksheet_Change rồi, tại đối tượng ThisWorkbook, bạn còn dùng thêm sub Workbook_SheetChange nữa. Và khi có sự thay đổi trên sheet thì 2 anh chàng này "đá" nhau chăng?

Có cách nào khắc phục không bác??giúp e với, mày mò mãi chưa được.e mới tự học làm macro nên cũng không rành lắm.

 

[nghiaphuc]

Có cách nào khắc phục không bác??giúp e với, mày mò mãi chưa được.e mới tự học làm macro nên cũng không rành lắm.

Sheet nào đã áp dụng sự kiện Worksheet_Change thì không được áp dụng sự kiện Workbook_SheetChange cho sheet đó nữa. Có 1 đứa con mà cùng một lúc ba nó bắt làm việc này, mẹ nó bắt làm việc khác thì nó biết nghe ai?!
Còn sửa như thế nào thì tùy mục đích sử dụng của bạn mà điều chỉnh thôi, có thể ghép các câu lệnh của 2 sub này cho phù hợp. Bạn xem trong file đính kèm là một ví dụ cho sự kết hợp này:

Yêu cầu giả định: Khi nhập (hoặc xóa) một (số) ô trong vùng D3:M20 thì sẽ thực hiện 2 việc:
1. Nếu ô vừa nhập có giá trị thì tô xám, ngược lại thì bỏ màu nền
2. Chọn ô trống đầu tiên (nếu có) trong vùng.

Code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    If Intersect(Target, [D3:M20]) Is Nothing Then Exit Sub
    For Each Cll In Target
        If IsEmpty(Cll) Then
            Cll.Interior.ColorIndex = xlNone
        Else
            Cll.Interior.ColorIndex = 15
        End If
    Next
    On Error Resume Next
    [D3:M20].SpecialCells(4)(1, 1).Select
    On Error GoTo 0
End Sub

 

[phongkiemtinh]

Sheet nào đã áp dụng sự kiện Worksheet_Change thì không được áp dụng sự kiện Workbook_SheetChange cho sheet đó nữa. Có 1 đứa con mà cùng một lúc ba nó bắt làm việc này, mẹ nó bắt làm việc khác thì nó biết nghe ai?!
Còn sửa như thế nào thì tùy mục đích sử dụng của bạn mà điều chỉnh thôi, có thể ghép các câu lệnh của 2 sub này cho phù hợp. Bạn xem trong file đính kèm là một ví dụ cho sự kết hợp này:

Yêu cầu giả định: Khi nhập (hoặc xóa) một (số) ô trong vùng D3:M20 thì sẽ thực hiện 2 việc:
1. Nếu ô vừa nhập có giá trị thì tô xám, ngược lại thì bỏ màu nền
2. Chọn ô trống đầu tiên (nếu có) trong vùng.

Code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    If Intersect(Target, [D3:M20]) Is Nothing Then Exit Sub
    For Each Cll In Target
        If IsEmpty(Cll) Then
            Cll.Interior.ColorIndex = xlNone
        Else
            Cll.Interior.ColorIndex = 15
        End If
    Next
    On Error Resume Next
    [D3:M20].SpecialCells(4)(1, 1).Select
    On Error GoTo 0
End Sub

E chưa hiểu ý anh lắm,a nói thêm chút không?
File e là vừa nhập công thức tự động cho từng work sheet , gần như giống nhau hết. Chỉ khác nhau 2 dòng MÀU XANH ở các sheet, thay đổi các giá trị này thôi.a xem dùm e.

Target.Offset(0, 7).Value = "CHAMMELION"
Target.Offset(0, 1).Value = "CD-"

 

[phongkiemtinh]

Sheet nào đã áp dụng sự kiện Worksheet_Change thì không được áp dụng sự kiện Workbook_SheetChange cho sheet đó nữa. Có 1 đứa con mà cùng một lúc ba nó bắt làm việc này, mẹ nó bắt làm việc khác thì nó biết nghe ai?!
Còn sửa như thế nào thì tùy mục đích sử dụng của bạn mà điều chỉnh thôi, có thể ghép các câu lệnh của 2 sub này cho phù hợp. Bạn xem trong file đính kèm là một ví dụ cho sự kết hợp này:

Yêu cầu giả định: Khi nhập (hoặc xóa) một (số) ô trong vùng D3:M20 thì sẽ thực hiện 2 việc:
1. Nếu ô vừa nhập có giá trị thì tô xám, ngược lại thì bỏ màu nền
2. Chọn ô trống đầu tiên (nếu có) trong vùng.

Code như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Cll As Range
    If Intersect(Target, [D3:M20]) Is Nothing Then Exit Sub
    For Each Cll In Target
        If IsEmpty(Cll) Then
            Cll.Interior.ColorIndex = xlNone
        Else
            Cll.Interior.ColorIndex = 15
        End If
    Next
    On Error Resume Next
    [D3:M20].SpecialCells(4)(1, 1).Select
    On Error GoTo 0
End Sub

E thử làm mà cũng không được, e không nhập công thức bằng code nữa mà dùng tính năng table trong excel thì code khi nhập liệu group 2 sheet cùng lúc vẫn lỗi. nhờ bác xem file dùm. NEW FORM.rar

 

[ptt]

Bạn có làm được bằng tay không? làm được sao không Record Macro và chỉnh sửa? (đối với VBA, thực hiện được = tay thì có thể viết Code cho các thao tác đó được thôi). Đó cũng là 1 cách học tốt mà!
chẳng hạn với bài này:

[B]Private Sub Worksheet_SelectionChange(ByVal Target As Range)[/B]

Dim myRange

If Intersect(Target, Range("A1:D100")) Is Nothing Then Exit Sub
If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then Exit Sub
If IsEmpty(Target) Then Exit Sub

Set myRange = Union(Range(Target, "D" & Target.Row), Range("A" & Target.Row + 1 & ":D100"))
    myRange.Find(What:="", After:=Target).Select

End Sub

Vừa xem lại thì mình chưa hiểu yêu cầu này phục vụ cho mục đích gì? VD có thể bạn tìm ô trống đầu tiên sau ô bạn chọn để thêm data: Ô A1 có dữ liệu => chọn A1 mà B1 trống => Code sẽ chạy & chọn B1 => bạn thêm dữ liệu vào B1 sau đó chọn ô khác chẳng hạn. Vậy dữ liệu B1 sai thì sau đó làm sao chọn lại được ô B1 để mà sửa đây? tốt nhất là ko nên sử dụng code Worksheet_SelectionChange mà tạo riêng 1 sub lúc nào cần thì chạy có lẽ sẽ hợp lý hơn.

Code của bác hay quá ạ.
Bác có thể chỉ giúp cách nhập dữ liệu theo 2 cột khác nhau được không ạ? Ví dụ khi nhập hết từ A1 đến A10 thì chuyển sang nhập tiếp từ C1 đến C10, và chỉ nhập trong 2 cột giới hạn này thôi.
Cảm ơn bác!