Lặp lại code tự động lấy giá trị ngày tháng năm

[Xuanviet318]

Em có đoạn code tự động nhập ngày tháng năm như bên dưới dành cho 1 cột. Em nhờ bác nào giúp em chỉnh sửa nó để dành cho 2 cột được không ạ.



Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, 1).Value = Date
Else
cell_.Offset(, 1).Value = ""
End If
Next cell_
Application.EnableEvents = True
End If
End Sub

 

[Phuocam]

Em có đoạn code tự động nhập ngày tháng năm như bên dưới dành cho 1 cột. Em nhờ bác nào giúp em chỉnh sửa nó để dành cho 2 cột được không ạ.



Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, 1).Value = Date
Else
cell_.Offset(, 1).Value = ""
End If
Next cell_
Application.EnableEvents = True
End If
End Sub

Thêm cột nào nữa ? B? C?

 

[Xuanviet318]

Thêm cột nào nữa ? B? C?

Ý em là đoạn code trên đang lấy giá trị ngày tháng cho cột bên phải cột A, và em lấy giá trị ngày tháng cho cột bên phải cột D nữa ạ?

 

[bebo021999]

Ý em là đoạn code trên đang lấy giá trị ngày tháng cho cột bên phải cột A, và em lấy giá trị ngày tháng cho cột bên phải cột D nữa ạ?

Sửa cái này:

Set rng = Intersect(Target, Range("a:a"))

Thành cái này?

Set rng = Intersect(Target, Range("a:a,d:d"))

 

[Xuanviet318]

Sửa cái này:

Set rng = Intersect(Target, Range("a:a"))

Thành cái này?

Set rng = Intersect(Target, Range("a:a,d:d"))

Dạ đúng rồi bác ơi. Nếu mà lấy giá trị bên trái của cột A thì như nào ạ. Em mới tìm hiểu về VBA excel lên chưa rõ lắm.

 

[bebo021999]

Dạ đúng rồi bác ơi. Nếu mà lấy giá trị bên trái của cột A thì như nào ạ. Em mới tìm hiểu về VBA excel lên chưa rõ lắm.

Cột trái cột A là cột nào? XFD?
Tìm hiểu hàm offset nhé.

 

[Xuanviet318]

Cột trái cột A là cột nào? XFD?
Tìm hiểu hàm offset nhé.

Dạ, ý em là dùng code trên để trả về giá trị ngày tháng bên trái cột D và bên phải A có được không ạ?
Kiểu cột D là cột nhập hàng. Khi bác nhập giá trị nó trả về ngày tháng năm về 1 cột bên trái ấy ạ?

 

[bebo021999]

Như thế này đúng không?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a,d:d"))
If Not rng Is Nothing Then
For Each cell_ In rng
With cell_.Offset(, iif(cell_ .column=1,1,-1))
If cell_.Value <> "" Then
.Value = Date
Else
.Value = ""
End If
End with
Next cell_
End If
End Sub

 

[Xuanviet318]

Như thế này đúng không?

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a,d:d"))
If Not rng Is Nothing Then
For Each cell_ In rng
With cell_.Offset(, iif(cell_ .column=1,1,-1))
If cell_.Value <> "" Then
.Value = Date
Else
.Value = ""
End If
End with
Next cell_
End If
End Sub

Em thấy báo lỗi ở câu lệnh withcell_.offset ấy ạ

 

[bebo021999]

Em thấy báo lỗi ở câu lệnh withcell_.offset ấy ạ

Mình hơi lười tí nên hay viết tắt, thêm số 0 vào offset nhé

With cell_.Offset(0, iif(cell_ .column=1,1,-1))

 

[Xuanviet318]

Mình hơi lười tí nên hay viết tắt, thêm số 0 vào offset nhé

With cell_.Offset(0, iif(cell_ .column=1,1,-1))

Không đc bác ạ. Bác hộ em nốt case này với.

 

[Phuocam]

Không đc bác ạ. Bác hộ em nốt case này với.

Thử code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a"))' Cột A
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, 1).Value = Date
Else
cell_.Offset(, 1).Value = ""
End If
Next cell_
Application.EnableEvents = True

'Thêm code cột D
Else
Set rng = Intersect(Target, Range("D:D"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, -1).Value = Date
Else
cell_.Offset(, -1).Value = ""
End If
Next cell_
Application.EnableEvents = True
End If

End Sub

 

[Xuanviet318]

Thử code

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range, cell_ As Range
Set rng = Intersect(Target, Range("a:a"))' Cột A
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, 1).Value = Date
Else
cell_.Offset(, 1).Value = ""
End If
Next cell_
Application.EnableEvents = True

'Thêm code cột D
Else
Set rng = Intersect(Target, Range("D:D"))
If Not rng Is Nothing Then
Application.EnableEvents = False
For Each cell_ In rng
If cell_.Value <> "" Then
cell_.Offset(, -1).Value = Date
Else
cell_.Offset(, -1).Value = ""
End If
Next cell_
Application.EnableEvents = True
End If

End Sub

Cảm ơn bác @Phuocam nhé! Em chạy thử ok rồi ạ.