تقييم الموضوع :
  • 0 أصوات - بمعدل 0
  • 1
  • 2
  • 3
  • 4
  • 5
مساعدة في كود حذف الحروف المكررة
#1
Rainbow 
السلام عليكم ورحمة الله وبركاته

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

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

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

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


الملفات المرفقة
.rar   بروجكت حذف الحروف المكررة.rar (الحجم : 178.73 ك ب / التحميلات : 18)
الرد }}}
تم الشكر بواسطة:
#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
الرد }}}
تم الشكر بواسطة:
#3
(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 حيث بقيت الحروف المكررة موجودة في الجملة ولعل الصورة المرفقة توضح ذلك
الكود الثاني حقق الاختيار الثاني
لكن نفرض ان المستخدم يريد حذف حروف معينة هو يختارها بنفسه
كيف يمكن ذلك


الملفات المرفقة صورة/صور
   
الرد }}}
تم الشكر بواسطة:
#4
كود :
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
الرد }}}
تم الشكر بواسطة:
#5
(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

للاسف لم ينجح الكود
الرد }}}
تم الشكر بواسطة:
#6
وعليكم السلام ورحمة الله وبركاته

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

تمنياتي لك وللجميع التوفيق
الرد }}}
تم الشكر بواسطة: سعود
#7
(27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته

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

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


تمنياتي لك وللجميع التوفيق
الرد }}}
تم الشكر بواسطة: سعود
#8
(27-01-21, 06:44 PM)العبادي 2 كتب :
(27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته

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

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


تمنياتي لك وللجميع التوفيق
هل جربت اخر مثال
آخر  خيار ضع اكثر من حرف بينهما فراغ
الرد }}}
تم الشكر بواسطة: baha , sendbad100
#9
(28-01-21, 05:36 PM)سعود كتب :
(27-01-21, 06:44 PM)العبادي 2 كتب :
(27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته

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

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


تمنياتي لك وللجميع التوفيق
هل جربت اخر مثال
آخر  خيار ضع اكثر من حرف بينهما فراغ

الاخ الكريم
كل الشكر والتقدير لكم
بارك الله فيكم
حقيقة لم الاحظ البرنامج الذي بالاسفل
نشكر كل الاخوة الذين ابدوا مساعدتهم
الرد }}}
تم الشكر بواسطة: baha
#10
هذان كودان
أحدهما يمنع تكرار أى حرف (مثلآ يترك أول ق ويحذف أى ق أخرى تأتى بعد ذلك)
والآخر يحذف أى حرف مكرر (مثلآ يحذف أى ق  حتى أول ق .فلايجعل فى الجملة أى ق)
كود :
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
الرد }}}
تم الشكر بواسطة: baha , baha


المواضيع المحتمل أن تكون متشابهة .
الموضوع : الكاتب الردود : المشاهدات : آخر رد
  [vb6.0] مساعدة بتعديل كود الضغط على مفتاح F1 في الكيبورد جلال اليمني 0 173 13-10-23, 08:04 PM
آخر رد: جلال اليمني
Question [سؤال] مساعدة فى الحدث KeyDown و KeyCode soom3aa 0 433 13-11-22, 09:06 AM
آخر رد: soom3aa
  [vb6.0] طلب مساعدة samer_g_m 1 541 07-11-22, 01:20 AM
آخر رد: Taha Okla
  طلب مساعدة في تحديد الترقيم مصمم هاوي 0 553 05-08-22, 04:43 PM
آخر رد: مصمم هاوي
Smile [vb6.0] كيف تلون البيانات المكررة في العمود وتلوين اكبر قيمة في العمود في mshflexgrid1 Mhqom 11 2,098 27-11-21, 02:55 AM
آخر رد: Mhqom
  [سؤال] مساعدة في عمل هذا الكود العبادي 2 11 2,961 09-09-21, 01:29 AM
آخر رد: اسلام الكبابى
  مساعدة في امتحاني Zahora 0 984 14-03-21, 08:06 PM
آخر رد: Zahora
  [vb6.0] مساعدة فى انشاء تقريرباستخدام active report aboezzat84 0 994 10-01-21, 10:53 PM
آخر رد: aboezzat84
  مساعدة في عدم تكرار سجلات الزواج مصمم هاوي 4 1,730 20-11-20, 06:18 AM
آخر رد: sendbad100
  مساعدة في عرض بيانات محددة في التقرير مصمم هاوي 1 1,421 17-09-20, 08:39 PM
آخر رد: مصمم هاوي

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم