منياوى قام بنشر أبريل 12, 2013 مشاركة قام بنشر أبريل 12, 2013 من فضلكم هل يمكن اذا كتبت أى كلمة عشوائية يتم تقسيم هذه الكلمة الى حروف ويعاد ترتيب هذه الحروف بطريقة عشوائية بحيث تعطينا كل الكلمات التى يمكن استخراجها من الكلمة التى تم كتابتها فى البداية فمثلا إذا كتبت " إستقلال " فى خلية معينه اريد : 1- ان يتم تقسيم هذه الكلمة الى حروف فى عدة خلايا إ س ت ق ل ا ل 2- وفى خلايا اخرى يتم ترتيب هذه الحروف بطريقة عشوائية بحيث نستخرج منها كل الكلمات التى تتكون من حروف الكلمة التى تم كتابتها فى البداية سواء كان لها معنى او لم يكن فكلمة " استقلال " تصبح مثلا القتسال الاتسقل لاقتسالا وهكذا ولسيادتكم جزيل الشكر رابط هذا التعليق شارك More sharing options...
احمد عبد الناصر قام بنشر أبريل 12, 2013 مشاركة قام بنشر أبريل 12, 2013 السلام عليكم استاذ يوسف لي ملاحظة ان ناتج ما ذكرت لكلمة استقلال سيكون 5040 كلمة فهل هذا ما تريد ؟ تحياتي رابط هذا التعليق شارك More sharing options...
منياوى قام بنشر أبريل 12, 2013 الكاتب مشاركة قام بنشر أبريل 12, 2013 اولا : اشكرك من اعماق قلبى على سرعة واهتمامك بالرد ثانيا : لو امكن . وانا لا اقصد كلمة " إستقلال " هذه الكلمة مجرد مثل . ولكن انا باقصد أى كلمة . لو أمكن ذلك ولكم جزيل الشكر رابط هذا التعليق شارك More sharing options...
احمد عبد الناصر قام بنشر أبريل 12, 2013 مشاركة قام بنشر أبريل 12, 2013 السلام عليكم حسنا جرب المرفق الكود منقول بالكامل و لم اعدل فيه اي حرف .لكن لا اعرف صاحبه الاصلي . النتيجة تعتمد علي عدد حروف الكلمة طبقا للتباديل في الرياضيات ان كانت الكلمة3 حروف ستكون النتيجة 6 كلمات وان كانت 7 حروف ستكون النتيجة 5040 كلمة . Dim CurrentRow As Long Sub GetString() Dim lngMax As Long Dim InString As String If Val(Application.Version) > 11 Then lngMax = 9 Else lngMax = 8 End If InString = Cells(1, 1) If Len(InString) < 2 Then Exit Sub If Len(InString) > lngMax Then MsgBox "Too many permutations!", vbExclamation Exit Sub Else Range(Cells(2, 1), Cells(Rows.Count, 1)).ClearContents CurrentRow = 1 Call GetPermutation("", InString) End If End Sub Sub GetPermutation(x As String, y As String) ' The source of this algorithm is unknown Dim i As Integer, j As Integer j = Len(y) If j < 2 Then Cells(CurrentRow, 1) = x & y CurrentRow = CurrentRow + 1 Else For i = 1 To j Call GetPermutation(x + Mid(y, i, 1), _ Left(y, i - 1) + Right(y, j - i)) Next End If End Sub تحياتي code+.rar 1 رابط هذا التعليق شارك More sharing options...
عبدالله باقشير قام بنشر أبريل 12, 2013 مشاركة قام بنشر أبريل 12, 2013 السلام عليكم كود ذكي جدا... جزاك الله خيرا اخي احمد تقبل تحياتي وشكري رابط هذا التعليق شارك More sharing options...
منياوى قام بنشر أبريل 13, 2013 الكاتب مشاركة قام بنشر أبريل 13, 2013 (معدل) تم تعديل أبريل 13, 2013 بواسطه jo11 رابط هذا التعليق شارك More sharing options...
منياوى قام بنشر أبريل 13, 2013 الكاتب مشاركة قام بنشر أبريل 13, 2013 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.