اليك الكود
CODE
Sub Put_Val()
'
Dim Arr()
Dim Arr_Target()
Dim Arr_Col_7()
Dim WB As Workbook
Dim Rng As Range
'================================================================
ScreenOff
Path = ThisWorkbook.Path & "\"
Set WB = Workbooks.Open(Filename:=Path & [C5])
'ÓØÑ ÈÏÇíÉ ÌÏæá ãáÝ ÇáãÕÏÑ
End_Row = Cells(Rows.Count, "c").End(xlUp).Row
'äØÇÞ ãáÝ ÇáãÕÏÑ ãä ÈÏÇíÉ ÚãæÏ ÇáÑÈØ (ÇáÑÞã ÇáÞæãì)
Arr = Range("c2:e" & End_Row)
WB.Close False
Set WB = Nothing
'================================================================
Set WB = Workbooks.Open(Filename:=Path & [C6])
'ÈÏÇíÉ ÚãæÏ ãáÝ ÇáåÏÝ
End_Row = Cells(Rows.Count, "A").End(xlUp).Row
'äØÇÝ ãáÝ ÇáåÏÝ
Arr_Target = Range("A2:g" & End_Row)
For x = LBound(Arr) To UBound(Arr)
For Row = LBound(Arr_Target) To UBound(Arr_Target)
If Arr_Target(Row, 1) = Arr(x, 1) Then
' ÇáÌÒÁ ÇáËÇäì ãä ÇáÓØÑ ÈÚÏ ÇáíÓÇæì ÑÞã ÚãæÏ Ýì ãáÝ ÇáãÕÏÑ ÇáãÑÇÏ ÌáÈå(ÇáãÑÊÈ)
Arr_Target(Row, 7) = Arr(x, 3)
End If
If Not Arr_Target(Row, 7) > 0 Then Arr_Target(Row, 7) = 0
Next
Next
Arr_Col_7 = ColumnVector(Arr_Target, 7)
Arr_Col_7 = One_Dimension_C(Arr_Col_7)
Arr_Col_7(0) = Cells(1, "G")
Set Rng = Range("G1").Resize(UBound(Arr_Col_7) + 1)
Rng = Application.Transpose(Arr_Col_7)
Application.DisplayAlerts = False
WB.Close True
Application.DisplayAlerts = True
'================================================================
ScreenOn
Set WB = Nothing
'
Application.DisplayAlerts = True
End Sub
Sub BANK_Val()
'
Dim Arr()
Dim Arr_Target()
Dim Arr_Col_11()
Dim WB As Workbook
Dim Rng As Range
'================================================================
ScreenOff
Path = ThisWorkbook.Path & "\"
Set WB = Workbooks.Open(Filename:=Path & [C5])
'ÓØÑ ÈÏÇíÉ ÌÏæá ãáÝ ÇáãÕÏÑ
End_Row = Cells(Rows.Count, "c").End(xlUp).Row
'äØÇÞ ãáÝ ÇáãÕÏÑ ãä ÈÏÇíÉ ÚãæÏ ÇáÑÈØ (ÇáÑÞã ÇáÞæãì)
Arr = Range("c2:e" & End_Row)
WB.Close False
Set WB = Nothing
'================================================================
Set WB = Workbooks.Open(Filename:=Path & [C6])
'ÈÏÇíÉ ÚãæÏ ãáÝ ÇáåÏÝ
End_Row = Cells(Rows.Count, "A").End(xlUp).Row
'äØÇÝ ãáÝ ÇáåÏÝ
Arr_Target = Range("A2:K" & End_Row)
For x = LBound(Arr) To UBound(Arr)
For Row = LBound(Arr_Target) To UBound(Arr_Target)
If Arr_Target(Row, 1) = Arr(x, 1) Then
' ÇáÌÒÁ ÇáËÇäì ãä ÇáÓØÑ ÈÚÏ ÇáíÓÇæì ÑÞã ÚãæÏ Ýì ãáÝ ÇáãÕÏÑ ÇáãÑÇÏ ÌáÈå(ÇáãÑÊÈ)
Arr_Target(Row, 11) = Arr(x, 3)
End If
If Not Arr_Target(Row, 11) > 0 Then Arr_Target(Row, 11) = 0
Next
Next
Arr_Col_11 = ColumnVector(Arr_Target, 11)
Arr_Col_11 = One_Dimension_C(Arr_Col_11)
Arr_Col_11(0) = Cells(1, "K")
Set Rng = Range("K1").Resize(UBound(Arr_Col_11) + 1)
Rng = Application.Transpose(Arr_Col_11)
Application.DisplayAlerts = False
WB.Close True
'================================================================
ScreenOn
Set WB = Nothing
'
End Sub
ظهور رسالة عند فتح ملف
