منتدى فيجوال بيسك لكل العرب | منتدى المبرمجين العرب

الصفحات : 1 2

السلام عليكم ورحمة الله وبركاته

ارجو من الاخوة الكرام مساعدتي في عمل كود يقوم بما يلي

اولا: حذف كل الحروف المكررة من الجملة

ثانيا: كود يحذف حروف معينة يحددها المستخدم

يوجد مرفق ارجو ادراج الكود به

(22-01-21, 11:39 PM)العبادي 2 كتب : [ -> ]السلام عليكم ورحمة الله وبركاته

ارجو من الاخوة الكرام مساعدتي في عمل كود يقوم بما يلي

اولا: حذف كل الحروف المكررة من الجملة

ثانيا: كود يحذف حروف معينة يحددها المستخدم

يوجد مرفق ارجو ادراج الكود به

كود :

Private Sub Command1_Click()

    Dim s As String

    If Me.Option1.Value = True Then

        Dim i As Integer, c1 As String, c2 As String

        s = Mid$(Text1, 1, 1)

        For i = 2 To Len(Text1)

            c1 = Mid$(Text1, i - 1, 1)

            c2 = Mid$(Text1, i, 1)

            If c1 <> c2 Then s = s & c2

        Next i

        Text2 = s

    ElseIf Me.Option2.Value = True Then

        s = Text1

        s = Replace(s, "ا", "")

        s = Replace(s, "س", "")

        Text2 = s

    End If

End Sub

(23-01-21, 11:22 AM)fghj كتب : [ -> ]
(22-01-21, 11:39 PM)العبادي 2 كتب : [ -> ]السلام عليكم ورحمة الله وبركاته

ارجو من الاخوة الكرام مساعدتي في عمل كود يقوم بما يلي

اولا: حذف كل الحروف المكررة من الجملة

ثانيا: كود يحذف حروف معينة يحددها المستخدم

يوجد مرفق ارجو ادراج الكود به

كود :

Private Sub Command1_Click() Dim s As String If Me.Option1.Value = True Then Dim i As Integer, c1 As String, c2 As String s = Mid$(Text1, 1, 1) For i = 2 To Len(Text1) c1 = Mid$(Text1, i - 1, 1) c2 = Mid$(Text1, i, 1) If c1 <> c2 Then s = s & c2 Next i Text2 = s ElseIf Me.Option2.Value = True Then s = Text1 s = Replace(s, "ا", "") s = Replace(s, "س", "") Text2 = s End If End Sub

مشكور اخي الكريم
بارك الله فيك
لكن الكود لم يحقق الاختيار رقم 1 حيث بقيت الحروف المكررة موجودة في الجملة ولعل الصورة المرفقة توضح ذلك
الكود الثاني حقق الاختيار الثاني
لكن نفرض ان المستخدم يريد حذف حروف معينة هو يختارها بنفسه
كيف يمكن ذلك

كود :

Private Sub Command1_Click()

    Dim i As Integer, s As String, c As String, r As String

    If Me.Option1.Value = True Then

        s = Text1

        For i = 1 To Len(s)

            c = Mid$(s, i, 1)

            If InStr(1, r, c) = 0 Or c = " " Then r = r & c

        Next

        r = Replace(r, "  ", " ")

        Text2 = r

    ElseIf Me.Option2.Value = True Then

        r = Replace(Text3, " ", "")

        r = Replace(r, ",", "")

        s = Text1

        For i = 1 To Len(r)

            s = Replace(s, Mid$(r, i, 1), "")

        Next

        Text2 = s

    End If

End Sub

(24-01-21, 11:37 AM)fghj2 كتب : [ -> ]

كود :

Private Sub Command1_Click() Dim i As Integer, s As String, c As String, r As String If Me.Option1.Value = True Then s = Text1 For i = 1 To Len(s) c = Mid$(s, i, 1) If InStr(1, r, c) = 0 Or c = " " Then r = r & c Next r = Replace(r, " ", " ") Text2 = r ElseIf Me.Option2.Value = True Then r = Replace(Text3, " ", "") r = Replace(r, ",", "") s = Text1 For i = 1 To Len(r) s = Replace(s, Mid$(r, i, 1), "") Next Text2 = s End If End Sub

للاسف لم ينجح الكود

وعليكم السلام ورحمة الله وبركاته

مثال حذف المكرر من الحروف

تمنياتي لك وللجميع التوفيق

(27-01-21, 12:45 PM)baha كتب : [ -> ]وعليكم السلام ورحمة الله وبركاته

مثال حذف المكرر من الحروف

مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)

تمنياتي لك وللجميع التوفيق

(27-01-21, 06:44 PM)العبادي 2 كتب : [ -> ]
(27-01-21, 12:45 PM)baha كتب : [ -> ]وعليكم السلام ورحمة الله وبركاته

مثال حذف المكرر من الحروف

مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)

تمنياتي لك وللجميع التوفيق

هل جربت اخر مثال

آخر خيار ضع اكثر من حرف بينهما فراغ

(28-01-21, 05:36 PM)سعود كتب : [ -> ]
(27-01-21, 06:44 PM)العبادي 2 كتب : [ -> ]
(27-01-21, 12:45 PM)baha كتب : [ -> ]وعليكم السلام ورحمة الله وبركاته

مثال حذف المكرر من الحروف

مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)

تمنياتي لك وللجميع التوفيق

هل جربت اخر مثال

آخر خيار ضع اكثر من حرف بينهما فراغ

الاخ الكريم
كل الشكر والتقدير لكم
بارك الله فيكم
حقيقة لم الاحظ البرنامج الذي بالاسفل
نشكر كل الاخوة الذين ابدوا مساعدتهم

هذان كودان
أحدهما يمنع تكرار أى حرف (مثلآ يترك أول ق ويحذف أى ق أخرى تأتى بعد ذلك)
والآخر يحذف أى حرف مكرر (مثلآ يحذف أى ق حتى أول ق .فلايجعل فى الجملة أى ق)

كود :

Private Sub Command1_Click()

 Dim myText As String

 Dim X As String

 Dim Y1 As String

 Dim Y2 As String

myText = Text1.Text

  I = 1

10 Lenn = Len(myText)

   X = Mid(myText, I, 1)

   I1 = InStr(myText, X): Print I1

   I2 = InStrRev(myText, X): Print I2

   If I1 = I2 Then GoTo 20

     Y1 = Mid(myText, 1, I)

     Y2 = Mid(myText, (I + 1), (Lenn - I))

     Y2 = Replace(Y2, X, "")

     myText = Y1 + Y2

    Print myText

20 If I < Lenn Then I = I + 1: GoTo 10

End Sub

Private Sub Command2_Click()

 Dim myText As String

 Dim X As String

 Dim Y1 As String

 Dim Y2 As String

myText = Text1.Text

  I = 1

10 Lenn = Len(myText)

   X = Mid(myText, I, 1)

   I1 = InStr(myText, X): Print I1

   I2 = InStrRev(myText, X): Print I2

   If I1 = I2 Then GoTo 20

     myText = Replace(myText, X, "")

    Print myText

20 If I < Lenn Then I = I + 1: GoTo 10

End Sub

الصفحات : 1 2