Giúp em code siêu khó: Worksheet change cho 2 cột khác nhau

[LeHang.93]

Các bác giúp em với ạ, em điền cột N thì nhảy, nhưng làm i hệt với cột O thì ko được do không thể gán Private Sub Worksheet_Change(ByVal Target As Range) trong cùng 1 sheet được ạ, em không biết cách nối 2 mảng này với nhau như thế nào

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp, Area As Range
On Error Resume Next
If Dic Is Nothing Then Autpen
If Not Intersect(Range("N6:N60000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("N6:N60000"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
ReDim Arr1(1 To UBound(aTarget, 1), 1 To 1)
ReDim Arr2(1 To UBound(aTarget, 1), 1 To 4)
ReDim Arr3(1 To UBound(aTarget, 1), 1 To 5)
For i = 1 To UBound(aTarget, 1)
If aTarget(i, 1) <> "" Then
tmp = aTarget(i, 1)
If Dic.Exists(tmp) Then
Arr1(i, 1) = aResult(Dic.Item(tmp), 5) '| Lookup du lieu

Arr2(i, 3) = aResult(Dic.Item(tmp), 3) '|

End If
End If
Next
rTarget.Offset(, -4).Resize(, 1).Value = Arr1
rTarget.Offset(, 2).Resize(, 4).Value = Arr2
rTarget.Offset(, 7).Resize(, 5).Value = Arr3
End If

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp, Area As Range
On Error Resume Next
If Dic Is Nothing Then Autpen
If Not Intersect(Range("O6:O60000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("O6:O60000"), Target)
If IsArray(rTarget.Value) Then
aTarget = rTarget.Value
Else
ReDim aTarget(1 To 1, 1 To 1)
aTarget(1, 1) = rTarget.Value
End If
ReDim Arr1(1 To UBound(aTarget, 1), 1 To 1)
ReDim Arr2(1 To UBound(aTarget, 1), 1 To 4)
ReDim Arr3(1 To UBound(aTarget, 1), 1 To 5)
For i = 1 To UBound(aTarget, 1)
If aTarget(i, 1) <> "" Then
tmp = aTarget(i, 1)
If Dic.Exists(tmp) Then
Arr1(i, 1) = aResult(Dic.Item(tmp), 5) '| Lookup du lieu

Arr2(i, 2) = aResult(Dic.Item(tmp), 4) '|

End If
End If
Next
rTarget.Offset(, -5).Resize(, 1).Value = Arr1
rTarget.Offset(, 2).Resize(, 4).Value = Arr2
rTarget.Offset(, 7).Resize(, 5).Value = Arr3
End If


End Sub

 

[Maika8008]

Not Intersect(Range("O6:O60000"), Target) Is Nothing Or Not Intersect(Range("N6:N60000"), Target) Is Nothing

 

[LeHang.93]

Not Intersect(Range("O6:O60000"), Target) Is Nothing Or Not Intersect(Range("N6:N60000"), Target) Is Nothing

Em cảm ơn Bác ạ

 

[LeHang.93]

Not Intersect(Range("O6:O60000"), Target) Is Nothing Or Not Intersect(Range("N6:N60000"), Target) Is Nothing

Bác ơi em có bỏ đoạn
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp, Area As Range
On Error Resume Next
If Dic Is Nothing Then Autpen

Sau khi bỏ đoạn vế thứ 2 thì của e chạy được rồi, nhưng sau khi bỏ song thì ví dụ đánh cột N chạy ra nhưng khi đánh cột O không có trong điều kiện thì sẽ mất hết, có cách nào không ạ ?

 

[HieuCD]

Các bác giúp em với ạ, em điền cột N thì nhảy, nhưng làm i hệt với cột O thì ko được do không thể gán Private Sub Worksheet_Change(ByVal Target As Range) trong cùng 1 sheet được ạ, em không biết cách nối 2 mảng này với nhau như thế nào

If Not Intersect(Range("N6:O60000"), Target) Is Nothing Then
If Not Intersect(Range("N6:N60000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("N6:N60000"), Target)
Else
Set rTarget = Intersect(Range("O6:O60000"), Target)
End If

 

[VetMini]

If Not Intersect(Range("N6:N60000"), Target) Is Nothing _
Or Not Intersect(Range("O6:O60000"), Target) Is Nothing Then
If Not Intersect(Range("N6:N60000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("N6:N60000"), Target)
Else
Set rTarget = Intersect(Range("O6:O60000"), Target)
End If

Set rTarget = Intersect(Target, Union("N6:N60000", "O6:O60000")) ' code này cho 2 ranges rời nhau, ở đây 2 ranges liền kề, thực ra có thể gom lại thành 1.
If Not rTarget Is Nothing Then
...

Chú: tiêu đề bài này chưa chắc không phạm quy.