Private Sub Worksheet_Change(ByVal Target As Range)
Dim rTarget As Range, aTarget, i As Long, n As Long
Dim Arr1(), Arr2(), Arr3(), tmp
On Error Resume Next
If Dic Is Nothing Then Auto_Open
If Not Intersect(Range("C6:C1000"), Target) Is Nothing Then
Set rTarget = Intersect(Range("C6:C1000"), 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 2)
ReDim Arr2(1 To UBound(aTarget, 1), 1 To 3)
ReDim Arr3(1 To UBound(aTarget, 1), 1 To 1)
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), 2)
Arr1(i, 2) = aResult(Dic.Item(tmp), 3)
Arr2(i, 1) = aResult(Dic.Item(tmp), 5)
Arr2(i, 2) = aResult(Dic.Item(tmp), 6)
Arr2(i, 3) = aResult(Dic.Item(tmp), 14)
Arr3(i, 1) = aResult(Dic.Item(tmp), 13)
End If
End If
Next
rTarget.Offset(, 1).Resize(, 2).Value = Arr1
rTarget.Offset(, 4).Resize(, 3).Value = Arr2
rTarget.Offset(, 11).Resize(, 1).Value = Arr3
End If
End Sub
