رجب جاويش

أخى الفاضل / حمادة عمر بسم الله ما شاء الله فكرة جميلة وتنفيذ أجمل وأروع تسلم ايديك وتسلم افكارك

أخى الحبيب / أحمد البحيرى جزاك الله كل خيرا فعلا معلومات قيمة جدا

الأخ والأستاذ الفاضل / مجدى يونس شرفنى جدا هذا المرور العطر فجزاك الله كل خير

أخى الحبيب / أبو حنين هذه شهادة أعتز بها من أخى المبدع صاحب الروائع أبو حنين جزاك الله كل خير أخى الحبيب

بعد اذن إخوتى الأفاضل الاستاذ / طارق وأخى الحبيب أبو حنين ولائراء الموضوع هذا حل آخر Sub ragab() [A1:C5].ClearContents For i = 1 To 3 For ii = 1 To 5 1 x = Int((15 - 1 + 1) * Rnd + 1) Cells(ii, i) = Cells(x, 11) y = Application.WorksheetFunction.CountIf(Range(Cells(ii, 1), Cells(ii, 3)), Cells(ii, i)) yy = Application.WorksheetFunction.CountIf(Range(Cells(1, i), Cells(5, i)), Cells(ii, i)) If y > 1 Or yy > 1 Then GoTo 1 Next Next End Sub اسماء عشوائية.rar

عذرا أخى الفاضل أرجو مزيد من التوضيح أو ارفاق ملف

أخى الفاضل /h2227779 جزاك الله كل خير أخى الفاضل / حمادة عمر جزاك الله كل خير أخى الفاضل على هذه الكلمات الطيبة

أخى الفاضل ضع مجموعة من البيانات بالطريقة التى تريدها ثم أرفق الملف

هل تقصد هكذا Vlookup_VBA_AA2.rar

والله المنتدى نور بمشاركة أخى الحبيب / أحمد البحيرى يارب نشوفك منور المنتدى دايما تسلم يا أبو عبير يا غالى

أخى الحبيب / محمود كل الشكر والتحية لمجهوداتك العظيمة ولاثراء الموضوع هذا تصور آخر لشكل المعادلة حسب فهمى لجدول الضريبة فى مرفق أخى الحبيب محمود =IF(AM6="";"";INDEX(data;MATCH(AM6;num;1);2))

تفضل أخى Private Function GetData(Path, File, Sheet, Address) Dim Data$ Data = "'" & Path & "[" & File & "]" & Sheet & "'!" & _ Range(Address).Range("A1").Address(, , xlR1C1) GetData = ExecuteExcel4Macro(Data) End Function Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [C1]) Is Nothing Then Dim FilePath$, Address$ '*************************************** Const FileName$ = "MyExcel.xlsm" Const SheetName$ = "ورقة1" FilePath = ActiveWorkbook.Path & "\" '*************************************** DoEvents Application.ScreenUpdating = False If Dir(FilePath & FileName) = Empty Then MsgBox "الملف " & FileName & " غير موجود", , "ملف غير موجود" Exit Sub End If x = Cells(1, 3).Value + 1 Address = Cells(x, 2).Address Cells(4, 3) = GetData(FilePath, FileName, SheetName, Address) Address = Cells(x, 3).Address Cells(5, 3) = GetData(FilePath, FileName, SheetName, Address) End If End Sub Vlookup_VBA.rar

تفضل أخى Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [C1]) Is Nothing Then Application.ScreenUpdating = False On Error Resume Next x = ActiveWorkbook.Path & "\" & "MyExcel" & ".xlsm" Workbooks.Open Filename:=x Set Rng = Sheets("æÑÞÉ1").Range("A2:A24") For Each cl In Rng If [C1] = cl Then Cells(4, 3) = cl.Offset(0, 1) Cells(5, 3) = cl.Offset(0, 2): Exit For End If Next Workbooks(x).Activate Activewindow.Close End If Application.ScreenUpdating = True Set Rng = Nothing End Sub Vlookup_VBA.rar

بعد اذن اخوتى الأعزاء لاثراء الموضوع هذا كود لتوزيع المواد بشكل عشوائى ولكن ليس بشكل قطرى ربما يفيد Sub ragab() [D9:J13].ClearContents For ii = 9 To 13 For i = 17 To 23 1 x = Int((10 - 4 + 1) * Rnd + 4) If Cells(ii, x) = "" Then Cells(ii, x) = Cells(i, 3) y = Application.WorksheetFunction.CountIf(Range(Cells(ii, 4), Cells(ii, 10)), Cells(ii, x)) If y > 1 Then GoTo 1 End If Next Next For R = 9 To 13 For T = 4 To 10 If Cells(R, T) = "" Then 2 xx = Int((23 - 17 + 1) * Rnd + 17) Cells(R, T) = Cells(xx, 3) yy = Application.WorksheetFunction.CountIf(Range(Cells(R, 4), Cells(R, 10)), Cells(R, T)) If yy > 1 Then GoTo 2 End If Next Next End Sub توزيع المواد بشكل عشوائى.rar

أخى الفاضل / ابو تميم يفضل ارفاق ملف حتى يمكن عمل المطلوب

بارك الله فيك أخى الحبيب محمود

أخى الفاضل / حمادة عمر يسعدنى أن أكود أول المهنئين لك بالترقية الى عضو مميز ألف مليون مبروك الترقية ومن تميز الى تميز دائما مع أطيب تمنياتى لك بدوام التوفيق والنجاح وكل الشكر لإدارة المنتدى على حسن الإختيار أخوك / رجب جاويش

أخى العزيز / عباد لمساتك دائما سحرية على الأكواد بارك الله فيك

تفضل أخى Sub ragab() For i = 13 To 34 1 x = Int((99 - 10 + 1) * Rnd + 10) Cells(i, 5) = x y = Application.WorksheetFunction.CountIf(Range("E13:E34"), Cells(i, 5)) If y > 1 Then GoTo 1 Next End Sub aaa1.rar

أخى الفاضل / علي رعد جزاك الله أخى الفاضل على هذا المرور العطر والكلمات الطيبة تقبل أرق وأجمل تحياتى

أخى الفاضل / عباد مرورك شرف كبير لى فجزاك الله كل خير على هذا المرور العطر

تفضل أخى Classeur1.rar

الأستاذ الفاضل / طارق محمود جزاك الله كل خير على هذه الكلمات الطيبة ويعتبر اللاب توب أبسط هدية تقدم لحضرتك وما يغلاش عليك أبدا لأن أول مساعدة قدمت لى فى هذا المنتدى كانت على يديك ولن انسى ذلك أبدا فجزاك الله كل خير على ما تقدمه من عطاء لكل أعضاء هذا المنتدى العريق أجزل الله لك العطاء فى الدنيا والآخرة تقبل ارق وأجمل تحياتى وشكرى

أخى الفاضل / حمادة عمر أشكرك أخى الفاضل شكرا جزيلا على هذه الكلمات الطيبة التى تدل على شخصكم الكريم فجزاك الله كل خير