Code thực thi cho những sheet được chỉ định (2 người xem)

Liên hệ QC

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

phongkiemtinh

Thành viên thường trực
Tham gia
22/7/09
Bài viết
224
Được thích
5
GPE cho e hỏi xem có code nào giúp lệnh thực thi trong code mình viết chỉ có tác dụng với những sheet được chỉ định không ah. E có code sau:
1/ trong module:
Option Explicit
Public Chk As Boolean, Dic As Object, aResult()
Sub Auto_Open()
Dim wks As Worksheet, SrcRng As Range, sArray
Dim lR As Long, I As Long, J As Long, n As Long, tmp
On Error Resume Next
Set wks = Sheets("Gcas list")
Set SrcRng = wks.Range("A1:B65536")
sArray = SrcRng.Value
ReDim aResult(1 To UBound(sArray, 1), 1 To UBound(sArray, 2))
Set Dic = CreateObject("Scripting.Dictionary")
For I = 1 To UBound(sArray, 1)
If CStr(sArray(I, 1)) <> "" Then
tmp = sArray(I, 1)
If Not Dic.exists(tmp) Then
lR = lR + 1
Dic.Add tmp, lR
For J = 1 To 2
aResult(lR, J) = sArray(I, J)
Next
End If
End If
Next
End Sub

2./ code trong worksheet:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


' nhap cong thuc do tim gcas tra ve cot Name,size
Application.ScreenUpdating = False


Dim rTarget As Range, aTarget, I As Long, J As Long, n As Long, TG As Double
Dim Arr(), tmp
On Error Resume Next

If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("G3:G65536"), Target) Is Nothing Then
Set rTarget = Intersect(Range("G3:G65536"), 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 Arr(1 To UBound(aTarget, 1), 1 To 3)
For I = 1 To UBound(aTarget, 1)
If aTarget(I, 1) <> "" Then
tmp = aTarget(I, 1)
If Dic.exists(tmp) Then
For J = 2 To 3
Arr(I, J - 1) = aResult(Dic.Item(tmp), J)
Next
End If
End If
Next
rTarget.Offset(, 2).Resize(, 2).Value = Arr


End If

Application.ScreenUpdating = True
End Sub


---->>>>>vậy có cách nào giúp e them dòng code chỉ có hiệu lực với 1 số sheet chứ không phải toàn workbook?xin xem file đính kèm code của e có tác dụng trên toàn workbook nên khi vào sheet "tonghop" e tổng hợp theo ngày thì ở cột và cột [J] không hiển thị (e kiểm tra là do ảnh hưởng code trên, bỏ code thì bình thường). Pass :gpe
 
Web KT

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

Back
Top Bottom