مساعدة في كود حذف الحروف المكررة - العبادي 2 - 22-01-21
السلام عليكم ورحمة الله وبركاته
ارجو من الاخوة الكرام مساعدتي في عمل كود يقوم بما يلي
اولا: حذف كل الحروف المكررة من الجملة
ثانيا: كود يحذف حروف معينة يحددها المستخدم
يوجد مرفق ارجو ادراج الكود به
RE: مساعدة في كود حذف الحروف المكررة - fghj - 23-01-21
(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
RE: مساعدة في كود حذف الحروف المكررة - العبادي 2 - 24-01-21
(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 حيث بقيت الحروف المكررة موجودة في الجملة ولعل الصورة المرفقة توضح ذلك
الكود الثاني حقق الاختيار الثاني
لكن نفرض ان المستخدم يريد حذف حروف معينة هو يختارها بنفسه
كيف يمكن ذلك
RE: مساعدة في كود حذف الحروف المكررة - fghj2 - 24-01-21
كود :
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
RE: مساعدة في كود حذف الحروف المكررة - العبادي 2 - 25-01-21
(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
للاسف لم ينجح الكود
RE: مساعدة في كود حذف الحروف المكررة - baha - 27-01-21
وعليكم السلام ورحمة الله وبركاته
مثال حذف المكرر من الحروف
تمنياتي لك وللجميع التوفيق
RE: مساعدة في كود حذف الحروف المكررة - العبادي 2 - 27-01-21
(27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته
مثال حذف المكرر من الحروف
مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)
تمنياتي لك وللجميع التوفيق
RE: مساعدة في كود حذف الحروف المكررة - سعود - 28-01-21
(27-01-21, 06:44 PM)العبادي 2 كتب : (27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته
مثال حذف المكرر من الحروف
مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)
تمنياتي لك وللجميع التوفيق
هل جربت اخر مثال
آخر خيار ضع اكثر من حرف بينهما فراغ
RE: مساعدة في كود حذف الحروف المكررة - العبادي 2 - 29-01-21
(28-01-21, 05:36 PM)سعود كتب : (27-01-21, 06:44 PM)العبادي 2 كتب : (27-01-21, 12:45 PM)baha كتب : وعليكم السلام ورحمة الله وبركاته
مثال حذف المكرر من الحروف
مشكور لكن هذا يحذف حروف مكررة في كلمة واحدة بعد الحرف
مثلا سعووووووووود يحذف الواو المكرر
لكن انا اريد يحذف اى حرف مكرر في الجملة
مثل سعود يذهب الى السوق بالسيارة
المفروض الناتج يكون
(عود يذهب الى وق باليارة)
تمنياتي لك وللجميع التوفيق
هل جربت اخر مثال
آخر خيار ضع اكثر من حرف بينهما فراغ
الاخ الكريم
كل الشكر والتقدير لكم
بارك الله فيكم
حقيقة لم الاحظ البرنامج الذي بالاسفل
نشكر كل الاخوة الذين ابدوا مساعدتهم
RE: مساعدة في كود حذف الحروف المكررة - اسلام الكبابى - 07-03-21
هذان كودان
أحدهما يمنع تكرار أى حرف (مثلآ يترك أول ق ويحذف أى ق أخرى تأتى بعد ذلك)
والآخر يحذف أى حرف مكرر (مثلآ يحذف أى ق حتى أول ق .فلايجعل فى الجملة أى ق)
كود :
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
|