اعمال یک فرمت خاص بر روی مجموعه ای از سلول ها

**abootorab** · 2015/02/19, 19:37

نوشته اصلی توسط amirhacker

سلام و درود
من یک فایلی دارم که قصد دارم در ستونی از اون فقط فرمت خاصی را قبول کنه.
قرمتش هم همان پلاک خودرو است. مثل 22 ج 555 ایران 22
اگه به غیر از این فرمت باشه قبول نکنه.
با فرمت سل نتونستم ردیف کنم و ئیتا ولیدشن را هم نتونستم روش اعمال کنم.
ممنون میشم راهنمایی بفرمائید.

با درود
با فرمتی که شما میخواین (فقط پلاک خودرو) و اینکه مقادیری به غیر از این فرمت قبول نکنه بنده از روش کد نویسی برای رویداد Worksheet_Change پیشنهاد میکنم، البته شاید به روشهای دیگه هم بشه که بنده بی اطلاعم. فقط کافیه روی شیت مورد نظر راست کلیک و سپس View Code رو کلیک کنید و در پنجره vb ظاهر شده کد زیر رو کپی کنید.
توجه داشته باشین که این کد فقط برای ستون A در نظر گرفتم که شما با یه تغییر کوچک میتونید به سلول های دیگر هم بسط دهید.

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    For i = 1 To Len(Target.Text)
        If Mid(Target.Text, i, 1) <> " " Then txt = txt & Mid(Target.Text, i, 1)
    Next i
    
    t1 = Mid(txt, 1, 2)
    t2 = Mid(txt, 3, 1)
    t3 = Mid(txt, 4, 3)
    t4 = Mid(txt, 7, 5)
    t5 = Mid(txt, 12, 2)
    iran = "199237209199228"

    If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Val(t2) > 0 Then Target.Value = ""
    If Val(t3) < 100 And Val(t2) > 999 Then Target.Value = ""
    For j = 1 To 5
        If Asc(Mid(t4, j, 1)) <> Val(Mid(iran, (j - 1) * 3 + 1, 3)) Then Target.Value = ""
    Next j
    If Val(t5) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Target.Value = "" Then Target.Select
End Sub

**amirhacker** · 2015/02/19, 23:24

نوشته اصلی توسط abootorab

با درود
با فرمتی که شما میخواین (فقط پلاک خودرو) و اینکه مقادیری به غیر از این فرمت قبول نکنه بنده از روش کد نویسی برای رویداد Worksheet_Change پیشنهاد میکنم، البته شاید به روشهای دیگه هم بشه که بنده بی اطلاعم. فقط کافیه روی شیت مورد نظر راست کلیک و سپس View Code رو کلیک کنید و در پنجره vb ظاهر شده کد زیر رو کپی کنید.
توجه داشته باشین که این کد فقط برای ستون A در نظر گرفتم که شما با یه تغییر کوچک میتونید به سلول های دیگر هم بسط دهید.

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    For i = 1 To Len(Target.Text)
        If Mid(Target.Text, i, 1) <> " " Then txt = txt & Mid(Target.Text, i, 1)
    Next i
    
    t1 = Mid(txt, 1, 2)
    t2 = Mid(txt, 3, 1)
    t3 = Mid(txt, 4, 3)
    t4 = Mid(txt, 7, 5)
    t5 = Mid(txt, 12, 2)
    iran = "199237209199228"

    If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Val(t2) > 0 Then Target.Value = ""
    If Val(t3) < 100 And Val(t2) > 999 Then Target.Value = ""
    For j = 1 To 5
        If Asc(Mid(t4, j, 1)) <> Val(Mid(iran, (j - 1) * 3 + 1, 3)) Then Target.Value = ""
    Next j
    If Val(t5) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Target.Value = "" Then Target.Select
End Sub

سلام و درود بر حضرتعالی و تشکر از زحمات شما
عرضم به حضورتون کد بالا تا رسیدن به ایران مشکلی نداره اما تایپ کردن ایران همانا و قبول کردن متن همانا.
If Len(txt) <> 14 Then Exit Sub میخام یه همچین کدی برای کنترل طول رشته و نفع نقص مورد اشاره به کد بالا اضافه نمایید.
ممنون

**abootorab** · 2015/02/20, 01:26

نوشته اصلی توسط amirhacker

سلام و درود بر حضرتعالی و تشکر از زحمات شما
عرضم به حضورتون کد بالا تا رسیدن به ایران مشکلی نداره اما تایپ کردن ایران همانا و قبول کردن متن همانا.
If Len(txt) <> 14 Then Exit Sub میخام یه همچین کدی برای کنترل طول رشته و نفع نقص مورد اشاره به کد بالا اضافه نمایید.
ممنون

درود مجدد
ضمن تشکر از دقت شما دوست عزیز
کد اصلاحی خدمت شما:

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 1 Or Target.Value = "" Then Exit Sub
    For i = 1 To Len(Target.Text)
        If Mid(Target.Text, i, 1) <> " " Then txt = txt & Mid(Target.Text, i, 1)
    Next i
    If Len(txt) > 13 Then
        Target.Value = ""
        Exit Sub
    End If
    
    t1 = Mid(txt, 1, 2)
    t2 = Mid(txt, 3, 1)
    t3 = Mid(txt, 4, 3)
    t4 = Mid(txt, 7, 5)
    t5 = Mid(txt, 12, 2)
    iran = "199237209199228"
    
    If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Val(t2) > 0 Then Target.Value = ""
    If Val(t3) < 100 And Val(t2) > 999 Then Target.Value = ""
    For j = 1 To 5
        If Asc(Mid(t4, j, 1)) <> Val(Mid(iran, (j - 1) * 3 + 1, 3)) Then Target.Value = ""
    Next j
    If Val(t5) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Target.Value = "" Then Target.Select
End Sub

**amirhacker** · 2015/02/20, 13:52

سلام و درود
بسیار عالی و ممنون از حضرتعالی
دو سه تا راهنمایی کوچولوی دیگه
میخواهم با conditionl formatting بگم اگه حرف ع یا ت رنگ سل زرد بشه اگه الف قرمز و در غیراینصورت سفید
این کد رو میزنم mid($A$1,4,1)=ع اما جواب نمیده میشه راهنمایی بفرمائید.

**حسام بحرانی** · 2015/02/20, 14:40

نوشته اصلی توسط amirhacker

سلام و درود
بسیار عالی و ممنون از حضرتعالی
دو سه تا راهنمایی کوچولوی دیگه
میخواهم با conditionl formatting بگم اگه حرف ع یا ت رنگ سل زرد بشه اگه الف قرمز و در غیراینصورت سفید
این کد رو میزنم mid($A$1,4,1)=ع اما جواب نمیده میشه راهنمایی بفرمائید.

سلام،
برای ستون مورد نظر 2 فرمت سل تعریف کنید؛
برای رنگ زرد سلول که دارای دوشرط است از فرمول زیر در conditionl formatting استفاده کنید:

کد PHP:

=IF(OR(MID(A1;4;1)="ع";MID(A1;4;1)="ت");1;0)

و برای رنگ قرمز که تنها یک شرط دارد از فرمت زیر استفاده نمایید:

کد PHP:

=IF(MID(A1;4;1)="ا";1;0)

بدیهی است در غیر اینصورت تغییری ایجاد نخواهد شد.
دقت کنید که فرمول های بالا را کپی پیست کنید.
موفق باشید.

**abootorab** · 2015/02/20, 15:16

نوشته اصلی توسط amirhacker

سلام و درود
بسیار عالی و ممنون از حضرتعالی
دو سه تا راهنمایی کوچولوی دیگه
میخواهم با conditionl formatting بگم اگه حرف ع یا ت رنگ سل زرد بشه اگه الف قرمز و در غیراینصورت سفید
این کد رو میزنم mid($A$1,4,1)=ع اما جواب نمیده میشه راهنمایی بفرمائید.

با درود و ضمن تشکر و کسب اجازه از جناب حسام عزیز
کد قبل رو اصلاح کردم و علاوه بر افزودن رنگ سلول ها، در مورد حرف "الف" کد قبل درست عمل نمیکرد که این نیز اصلاح شد.

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 1 Or Target.Value = "" Then 
        Target.Interior.Pattern = xlNone
        Exit Sub
    End If
    For i = 1 To Len(Target.Text)
        If Mid(Target.Text, i, 1) <> " " Then txt = txt & Mid(Target.Text, i, 1)
    Next i
    
    If Mid(txt, 3, 3) = "الف" Then
        If Len(txt) > 15 Then
            Target.Value = ""
            Exit Sub
        End If
        t1 = Mid(txt, 1, 2)
        t2 = Mid(txt, 3, 3)
        t3 = Mid(txt, 6, 3)
        t4 = Mid(txt, 9, 5)
        t5 = Mid(txt, 14, 2)
    ElseIf Mid(txt, 3, 1) <> "ا" Then
        If Len(txt) > 13 Then
            Target.Value = ""
            Exit Sub
        End If
        t1 = Mid(txt, 1, 2)
        t2 = Mid(txt, 3, 1)
        t3 = Mid(txt, 4, 3)
        t4 = Mid(txt, 7, 5)
        t5 = Mid(txt, 12, 2)
    End If
    
    If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Val(t2) > 0 Then Target.Value = ""
    If Val(t3) < 100 And Val(t2) > 999 Then Target.Value = ""
    iran = "199237209199228"
    For j = 1 To 5
        If Asc(Mid(t4, j, 1)) <> Val(Mid(iran, (j - 1) * 3 + 1, 3)) Then Target.Value = ""
    Next j
    If Val(t5) < 10 And Val(t2) > 99 Then Target.Value = ""
    
    If Target.Value = "" Then Target.Select
    If t2 = "ع" Or t2 = "ت" Then
        Target.Interior.Pattern = xlSolid
        Target.Interior.Color = 65535
    ElseIf t2 = "الف" Then
        Target.Interior.Pattern = xlSolid
        Target.Interior.Color = 255
    Else
        Target.Interior.Pattern = xlNone
    End If
End Sub

**amirhacker** · 2015/02/20, 15:55

نوشته اصلی توسط abootorab

با درود و ضمن تشکر و کسب اجازه از جناب حسام عزیز
کد قبل رو اصلاح کردم و علاوه بر افزودن رنگ سلول ها، در مورد حرف "الف" کد قبل درست عمل نمیکرد که این نیز اصلاح شد.

به عنوان آخرین درخواست در این موضوع. در حال حاضر حروفغیر فارسی را هم قبول می کنه. میخواهم یه فیلتر هم برای این موضوع بگذارم.
به نظرتون این مناسبه

کد PHP:


If Val(t2) < 199 or Val(t2) > 229 Then Target.Value = ""

اما حرف ی را شامل نمیشه

**abootorab** · 2015/02/20, 20:15

نوشته اصلی توسط amirhacker

به عنوان آخرین درخواست در این موضوع. در حال حاضر حروفغیر فارسی را هم قبول می کنه. میخواهم یه فیلتر هم برای این موضوع بگذارم.
به نظرتون این مناسبه

کد PHP:


If Val(t2) < 199 or Val(t2) > 229 Then Target.Value = ""

اما حرف ی را شامل نمیشه

درود مجدد
تغییرات مربوط به عدم قبول حروف غیر فارسی و همچنین علائم اعمال شد.
خدمت شما:

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Target.Column <> 1 Or Target.Value = "" Then
        Target.Interior.Pattern = xlNone
        Exit Sub
    End If
    For i = 1 To Len(Target.Text)
        If Mid(Target.Text, i, 1) <> " " Then txt = txt & Mid(Target.Text, i, 1)
    Next i
    
    For i = 1 To Len(txt)
        chk = True
        h = Mid(txt, i, 1)
        If Asc(h) < 48 Then chk = False
        If Asc(h) > 57 And Asc(h) < 129 Then chk = False
        If Asc(h) > 129 And Asc(h) < 141 Then chk = False
        If Asc(h) > 144 And Asc(h) < 152 Then chk = False
        If Asc(h) > 152 And Asc(h) < 170 Then chk = False
        If Asc(h) > 170 And Asc(h) < 192 Then chk = False
        If Asc(h) = 143 Or Asc(h) = 215 Or Asc(h) = 220 Or Asc(h) = 224 Or Asc(h) = 226 Then chk = False
        If Asc(h) > 230 And Asc(h) < 236 Then chk = False
        If Asc(h) > 237 Then chk = False
        If chk = False Then
            Target.Value = ""
            Target.Interior.Pattern = xlNone
            Exit Sub
        End If
    Next i
    
    If Mid(txt, 3, 3) = "الف" Then
        If Len(txt) > 15 Then
            Target.Value = ""
            Exit Sub
        End If
        t1 = Mid(txt, 1, 2)
        t2 = Mid(txt, 3, 3)
        t3 = Mid(txt, 6, 3)
        t4 = Mid(txt, 9, 5)
        t5 = Mid(txt, 14, 2)
    ElseIf Mid(txt, 3, 1) <> "ا" Then
        If Len(txt) > 13 Then
            Target.Value = ""
            Exit Sub
        End If
        t1 = Mid(txt, 1, 2)
        t2 = Mid(txt, 3, 1)
        t3 = Mid(txt, 4, 3)
        t4 = Mid(txt, 7, 5)
        t5 = Mid(txt, 12, 2)
    End If
    
    If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
    If Val(t2) > 0 Then Target.Value = ""
    If Val(t3) < 100 And Val(t2) > 999 Then Target.Value = ""
    iran = "199237209199228"
    For j = 1 To 5
        If Asc(Mid(t4, j, 1)) <> Val(Mid(iran, (j - 1) * 3 + 1, 3)) Then Target.Value = ""
    Next j
    If Val(t5) < 10 And Val(t2) > 99 Then Target.Value = ""
    
    If Target.Value = "" Then Target.Select
    If t2 = "ع" Or t2 = "ت" Then
        Target.Interior.Pattern = xlSolid
        Target.Interior.Color = 65535
    ElseIf t2 = "الف" Then
        Target.Interior.Pattern = xlSolid
        Target.Interior.Color = 255
    Else
        Target.Interior.Pattern = xlNone
    End If
End Sub

**amirhacker** · 2015/02/20, 21:15

سلام و درود از زحمات بی منت حضرتعالی.
اگه ممکنه یه مقدار ابهامات بنده را برطرف نمایید.
من از این تکه کد If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
فهمیدم که اگه دوعددی که برای حروف اوله کمتر وارد بشه قبول نمی کنه و همچنین برای حرف اگه بیشتر از یک حرف باشه اینگونه عمل میکنه.
فقط مشکلم اینه که مبنا و اصول این 10(برای اعداد) و 99 (برای حروف) را درک نمی کنم.
چرا در دو خط پایینتر t2>999 در نظر گرفته شده منظور اگر بیشتر از سه حرف باشد است اما سوال چرا تو دو خط بالاتر این را در نظر نگرفته

**abootorab** · 2015/02/20, 22:41

نوشته اصلی توسط amirhacker

سلام و درود از زحمات بی منت حضرتعالی.
اگه ممکنه یه مقدار ابهامات بنده را برطرف نمایید.
من از این تکه کد If Val(t1) < 10 And Val(t2) > 99 Then Target.Value = ""
فهمیدم که اگه دوعددی که برای حروف اوله کمتر وارد بشه قبول نمی کنه و همچنین برای حرف اگه بیشتر از یک حرف باشه اینگونه عمل میکنه.
فقط مشکلم اینه که مبنا و اصول این 10(برای اعداد) و 99 (برای حروف) را درک نمی کنم.
چرا در دو خط پایینتر t2>999 در نظر گرفته شده منظور اگر بیشتر از سه حرف باشد است اما سوال چرا تو دو خط بالاتر این را در نظر نگرفته

با درود
دوست عزیز نمیدونم شما با vb آشنایی دارید یه نه ولی یه توضیح مختصر در مورد سوالتون میدم، امیدوارم ابهامتون برطرف بشه.
کلا شماره پلاک خودرو از 5 قسمت تشکیل میشه، به عنوان مثال "22 ایران 336 ج 63"، کد فوق میاد ابتدا فواصل خالی متن تایپ شده رو از بین میبره و یک رشته 13 کاراکتری (اگر به جای تک حرف "ج" حرف "الف" باشد رشته 15 کاراکتری) به ما میدهد و سپس 5 قسمت تشکیل دهنده شماره پلاک رو به تفکیک در متغیرهای t1 الی t5 قرار میدهد. (یادمان باشد تمام این 5 قسمت از نوع رشته در tها ذخیره میشوند). حال شزط ها را اجرا میکنیم متغیر اول "63"=t1 رو با تابع Val به عدد تبدیل میکنیم و شرط دو رقمی بودن آن را بررسی میکنیم، متغیر دوم "ج"=t2 نیز با Val به عدد تبدیل میکنیم ولی حروف وقتی به عدد تبدیل میکنیم حاصل آن صفر میشود و این شرط برای t2 بررسی میکنیم، متغیر سوم یعنی "336"=t3 نیز مانند متغیر اول عمل کردم ولی با این تفاوت که چون این عدد باید سه رقمی باشد آن را در محدوده 100 تا 999 کنترل میکنیم، متغیر چهارم که کلمه "ایران"=t4 است نیز بصورت تک تک حروفی بررسی میشه که صحیح باشد (علت کنترل تک به تک حروف مشکلی است که اکسل در عدم تطابق بعضی از حروف فارسی است) و در نهایت متغیر پنجم یعنی "22"=t5 می باشد که دقیقا مانند متغیر اول شرط را برای آن بررسی میکنیم.
توضیح: تابع Val جهت تبدیل یک رشته عددی به یک عدد واقعی به کار میرود که اگر به جای رشته عددی رشته حروفی درون تابع قرار دهیم حاصل تابع عدد صفر میشود.

امیدوارم مفهوم رو خوب رسونده باشم.