Lặp lại code tự động lấy giá trị ngày tháng năm (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Tôi tuân thủ nội quy khi đăng bài

Xuanviet318

Thành viên mới
Tham gia
17/2/23
Bài viết
7
Được thích
0
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
 

File đính kèm

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?
 
Upvote 0
Ý 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:
PHP:
Set rng = Intersect(Target, Range("a:a"))
Thành cái này?
PHP:
Set rng = Intersect(Target, Range("a:a,d:d"))
 
Upvote 0
Sửa cái này:
PHP:
Set rng = Intersect(Target, Range("a:a"))
Thành cái này?
PHP:
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.
 
Upvote 0
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 ạ?
 
Upvote 0
Như thế này đúng không?
PHP:
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
 
Upvote 0
Như thế này đúng không?
PHP:
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 ạ
 
Upvote 0
Không đc bác ạ. Bác hộ em nốt case này với.
Thử code

Mã:
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
 
Upvote 0
Thử code

Mã:
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 ạ.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom