Làm sao để code có thể chạy được trên nhiều cột của bảng tính

[Lê Duy Thương]

Em đang gặp một số vấn đề của bảng tính mong mọi người giúp đỡ
chẳng là thấy code cũng rất hang mà chạy lại nhanh nên tìm trên diễn đan thấy code của bác sa_qd hay , bèn chỉnh sửa lại và áp dụng thử cho công việc
nhưng khi sử dụng cho cột thứ 2 thì báo lỗi
mà không biết do đâu nên nhờ các anh chị em giúp đỡ
em xin cảm ơn và hậu tạ bằng 1 chầu cafe ( tuổi ngọc friends ở đường đồng khởi -biên hòa)

 

[ndu96081631]

Em đang gặp một số vấn đề của bảng tính mong mọi người giúp đỡ
chẳng là thấy code cũng rất hang mà chạy lại nhanh nên tìm trên diễn đan thấy code của bác sa_qd hay , bèn chỉnh sửa lại và áp dụng thử cho công việc
nhưng khi sử dụng cho cột thứ 2 thì báo lỗi
mà không biết do đâu nên nhờ các anh chị em giúp đỡ
em xin cảm ơn và hậu tạ bằng 1 chầu cafe ( tuổi ngọc friends ở đường đồng khởi -biên hòa)

File này có đoạn code:

Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [COLOR=Red][B][K6:K200][/B][/COLOR]) Is Nothing Then
   With Target.Offset(, 1)
      .NoteText .NoteText & "+" & Date & ":= " & Target.Value
      .Value = .Value + Target.Value
   End With
    End If
End Sub

Vùng hoạt động của code là [K6:K200] ---> Giờ nếu bạn muốn thay thành vùng khác thì cứ sửa cái này là xong chứ gì

 

[ptm0412]

Cụ thể như sau:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim Myrange As Range
Set Myrange = Union([K6:K200], [n6:n200], [q6:q200], [t6:t200], [w6:w200], _
[z6:z200], [ac6:ac200], [af6:af200], [ai6:ai200], [aL6:aL200], [aO6:aO200])
 If Not Intersect(Target, Myrange) Is Nothing Then
   With Target.Offset(, 1)
      .NoteText .NoteText & "+" & Date & ":= " & Target.Value
      .Value = .Value + Target.Value
   End With
    End If
Application.ScreenUpdating = True
End Sub

 

[Lê Duy Thương]

cụ thể như sau:

private sub worksheet_change(byval target as range)
application.screenupdating = false
dim myrange as range
set myrange = union([k6:k200], [n6:n200], [q6:q200], [t6:t200], [w6:w200], _
[z6:z200], [ac6:ac200], [af6:af200], [ai6:ai200], [al6:al200], [ao6:ao200])
if not intersect(target, myrange) is nothing then
with target.offset(, 1)
.notetext .notetext & "+" & date & ":= " & target.value
.value = .value + target.value
end with
end if
application.screenupdating = true
end sub

cảm ơn hai bác ptm và ndu
lần nào hai bác cũng là người trả lời nhanh nhất bài của em
tuy là hai cách hướng dẫn khác nhau nhưng kq giống nhau
thật không ngờ ngoài những công thức excel còn mạnh cả về code nữa
trân trọng mời hai bác uống cafe chủ nhật này
he ee he

 

[sealand]

Mình tham gia 1 cách cũng dễ sử lý, khi cần thêm 1 cột thì cứ việc thêm 1 cái Or

Private Sub worksheet_change(ByVal target As Range)
Dim c: c = target.Column
If target.Row > 5 And target.Row < 11 Then
If c = 11 Or c = 14 Or c = 17 Or c = 20 Or c = 23 Or c = 26 _
        Or c = 29 Or c = 32 Or c = 35 Or c = 38 Or c = 41 Then
With target.Offset(, 1)
.NoteText .NoteText & "+" & Date & ":= " & target.Value
.Value = .Value + target.Value
End With: End If: End If
End Sub