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

Liên hệ QC MyVTV Add-ins

leuk

Thành viên mới
Tham gia ngày
20 Tháng tám 2020
Bài viết
31
Được thích
5
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 Auto_Open
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 Auto_Open
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
 

File đính kèm

  • Thuc Hanh.3.xls
    108 KB · Đọc: 4

Maika8008

Tích cực để lên đời
Tham gia ngày
12 Tháng sáu 2020
Bài viết
1,673
Được thích
1,761
Giới tính
Nam
Not Intersect(Range("O6:O60000"), Target) Is Nothing Or Not Intersect(Range("N6:N60000"), Target) Is Nothing
 

leuk

Thành viên mới
Tham gia ngày
20 Tháng tám 2020
Bài viết
31
Được thích
5
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 Auto_Open
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

Chuyên gia GPE
Tham gia ngày
14 Tháng chín 2010
Bài viết
8,145
Được thích
16,686
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
 
Lần chỉnh sửa cuối:

VetMini

Chuyên gia GPE
Tham gia ngày
21 Tháng mười hai 2012
Bài viết
11,740
Được thích
14,865
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.
 
Top Bottom