اعطاء قيمة بشروط معينة

Sub test()

 Dim sh As Worksheet:    Set sh = Sheets("DATA")

 Dim rng As Range

 Set rng = sh.Range("BG5:BG1000")

 Application.ScreenUpdating = False

 sh.Range("CI5:CI1000").ClearContents

'-------------------------------------------------------------------------------------

For Each c In rng

   

   For x = 1 To 20

     If c.Value = "مادة" & x And c.Offset(3, -1) = "ل" And c.Offset(2, -1) = "" Then

       c.Offset(0, 28) = c.Offset(1, -1)

    

     ElseIf c.Value = "مادة" & x And c.Offset(3, -1) = "ج" And c.Offset(2, -1) = "" Then

       c.Offset(0, 28) = c.Offset(1, -1)

    

     ElseIf c.Value = "مادة" & x And c.Offset(3, -1) = "ج ج" And c.Offset(2, -1) = "" Then

       c.Offset(0, 28) = c.Offset(1, -1)

'          --------------------------------------------------------

     ElseIf c.Value = "مادة" & x And c.Offset(3, -1) = "ل" And c.Offset(2, -1) <> "" Then

       c.Offset(0, 28) = c.Offset(2, -1)

    

     ElseIf c.Value = "مادة" & x And c.Offset(3, -1) = "ج" And c.Offset(2, -1) <> "" Then

       c.Offset(0, 28) = c.Offset(2, -1)

    

     ElseIf c.Value = "مادة" & x And c.Offset(3, -1) = "ج ج" And c.Offset(2, -1) <> "" Then

       c.Offset(0, 28) = c.Offset(2, -1)

     End If

  Next x

Next c

'-------------------------------------------------------------------------------------

Application.ScreenUpdating = True

End Sub