پرسش اصلاح فرمول vba

[امین نیما]

با سلام و صبح بخیر خدمت دوستان
این فرمول را با راهنمایی دوستان نوشتم همان طور که مشاهده میفرمایید من شرط گذاشتم اگه Qبرابر 1 یا 2 یا 4 بود آنگاه در سلول 17 بنویسه D و در سلول 18 بنویسه E من مجبور شدم این شرط را 2 با بنویسم

Y = ActiveSheet.Cells(5).Column
K = ActiveSheet.Cells(35).Column
For i = Y To K

If Cells(4, i) <> "*" Then
Q = LCase(Cells(3, i).Value)

If Q = "1" Or Q = "2" Or Q = "4 " Then Cells(17, i).Value = "D"
If Q = "1" Or Q = "2" Or Q = "4 " Then Cells(18, i).Value = "E"

Else
Cells(17, i).Value = ""
Cells(18, i).Value = ""

End If

Next i

چطور باید فرمول اصلاح بشه که مثلا بگیم گه Q برابر 1یا 2 یا 3 بود درسلول 17 بنویس D و در سلول 18 بنویس D

If Q = "1" Or Q = "2" Or Q = "4 " Then Cells(17, i).Value = "D" And Cells(18, i).Value = "E"

سوال دوم من هم این است که اگه مشاهده بفرمایید در فرمول به جای نوشتن هر باره LCase(Cells(3, i).Value) از Q استفاده کردیم
من خواستم به جای نوشتن Then Cells(17, i).Value از SH1 و به جای Cells(18, i).Value از SH2 استفاده کنم به این صورت

If Cells(4, i) <> "*" Then
Q = LCase(Cells(3, i).Value)
SH1 = Cells(17, i).Value
SH2 = Cells(18, i).Value

If Q = "1" Or Q = "2" Or Q = "4 " Then SH1 = "D" And SH2 = "E"

Else
SH1 = ""
SH2 = ""

End If

اما جواب نمیده به این صورت
دوستان و اساتید راهنمایی بفرمایند مشکل من چطور باید حل شود ممنون میشم
با تشکر

[iranweld]

لطفا فایل را هم ضمیمه کنید که نیاز به نوشتن مجدد فایل اکسل جدید نباشد

[امین نیما]

لطفا فایل را هم ضمیمه کنید که نیاز به نوشتن مجدد فایل اکسل جدید نباشد

خدمت شما

[iranweld]

با سلام

مورد اول ماکرو درست شد

For i = y To K

If Cells(4, i) <> "*" Then

Q = LCase(Cells(3, i).Value)

If Q = "1" Or Q = "2" Or Q = "4" Then

Cells(6, i).Value = "D"

Cells(7, i).Value = "E"

Else

Cells(6, i).Value = ""
Cells(7, i).Value = ""

End If

End If