اصلاح فرمول 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