رجب جاويش

تفضل أخى المصنف1.rar المصنف1.rar

تفضل أخى Book1.rar

أخى حمادة جرب المرفق ترحيل بيانات33.rar

هل تقصد هكذا حل الفزروة2.rar

أخى الصقر بالفعل فورم جميل ورائع تسلم ايديك أخى ياسر أنا فعلا أعتمدت فى الكود على ان الارقام غير مكررة جزاكم الله كل خير

تفضل أخى وعذرا للتأخير عليك ترحيل بيانات33.rar

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

أخى الحبيب ياسر قمت بتحديد الخلايا من A3 الى A29 مرة واحدة ثم وضعت المعادلة فى شريط الصيغة ثم ضغط ctrl + enter

وهذا حل آخر حل الفزورة.rar

ايوه أخى الفاضل وكنت أسال هل بقية الترحيل كما تريد اذا كان كما تريد اقوم بعمل النقطة الخاصة بترحيل اسم الشهر

وبالنسبة للترحيل هل هو كما تريد ؟

أخى حمادة جرب المرفق ترحيل بيانات1.rar

المهندس الفاضل / محمد طاهر ما زالت المشكلة موجودة

أخى حماده عندما يتم الترحيل الى صفحة D يتم ذلك فى السطر السابع ( تمام كدا ) وفى الترحيل التالى سوف يتم فى السطر الثامن وهكذا الى أن نصل الى السطر 15 ولكن عند الترحيل بعد ذلك ( أين يتم الترحيل ) علما بأن السطر 16 به معادلات كما تقول أرجو التوضيح

تفضل أخى علما بان اسم المستخدم ragab وكلمة المرور 123 ويمكنك تغيرهما من الخلايا A1 و A2 من الصفحة الأولى Book1.rar تفضل أخى علما بان اسم المستخدم ragab وكلمة المرور 123 ويمكنك تغيرهما من الخلايا A1 و A2 من الصفحة الأولى Book1.rar

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

أخى ياسر أحبك الله الذى أحببتنى فيه

وهذا كود آخر منقول من موقع أجنبى Option Explicit '//////////////////////////////////////////////////////////////////// 'Password masked inputbox 'Allows you to hide characters entered in a VBA Inputbox. ' 'Code written by Daniel Klann 'http://www.danielklann.com/ 'March 2003 '// Kindly permitted to be amended '// Amended by Ivan F Moala '// http://www.xcelfiles.com '// April 2003 '// Works for Xl2000+ due the AddressOf Operator '//////////////////////////////////////////////////////////////////// '******************** CALL FROM FORM ********************************* ' Dim pwd As String ' ' pwd = InputBoxDK("Please Enter Password Below!", "Database Administration Security Form.") ' ' 'If no password was entered. ' If pwd = "" Then ' MsgBox "You didn't enter a password! You must enter password to 'enter the Administration Screen!" _ ' , vbInformation, "Security Warning" ' End If '************************************** 'API functions to be used Private Declare Function CallNextHookEx _ Lib "user32" ( _ ByVal hHook As Long, _ ByVal ncode As Long, _ ByVal wParam As Long, _ lParam As Any) _ As Long Private Declare Function GetModuleHandle _ Lib "kernel32" _ Alias "GetModuleHandleA" ( _ ByVal lpModuleName As String) _ As Long Private Declare Function SetWindowsHookEx _ Lib "user32" _ Alias "SetWindowsHookExA" ( _ ByVal idHook As Long, _ ByVal lpfn As Long, _ ByVal hmod As Long, _ ByVal dwThreadId As Long) _ As Long Private Declare Function UnhookWindowsHookEx _ Lib "user32" ( _ ByVal hHook As Long) _ As Long Private Declare Function SendDlgItemMessage _ Lib "user32" Alias "SendDlgItemMessageA" ( _ ByVal hDlg As Long, _ ByVal nIDDlgItem As Long, _ ByVal wMsg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) _ As Long Private Declare Function GetClassName _ Lib "user32" _ Alias "GetClassNameA" ( _ ByVal hWnd As Long, _ ByVal lpClassName As String, _ ByVal nMaxCount As Long) _ As Long Private Declare Function GetCurrentThreadId _ Lib "kernel32" () _ As Long 'Constants to be used in our API functions Private Const EM_SETPASSWORDCHAR = &HCC Private Const WH_CBT = 5 Private Const HCBT_ACTIVATE = 5 Private Const HC_ACTION = 0 Private hHook As Long Public Function NewProc(ByVal lngCode As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim RetVal Dim strClassName As String, lngBuffer As Long If lngCode < HC_ACTION Then NewProc = CallNextHookEx(hHook, lngCode, wParam, lParam) Exit Function End If strClassName = String$(256, " ") lngBuffer = 255 If lngCode = HCBT_ACTIVATE Then 'A window has been activated RetVal = GetClassName(wParam, strClassName, lngBuffer) If Left$(strClassName, RetVal) = "#32770" Then 'Class name of the Inputbox 'This changes the edit control so that it display the password character *. 'You can change the Asc("*") as you please. SendDlgItemMessage wParam, &H1324, EM_SETPASSWORDCHAR, Asc("*"), &H0 End If End If 'This line will ensure that any other hooks that may be in place are 'called correctly. CallNextHookEx hHook, lngCode, wParam, lParam End Function '// Make it public = avail to ALL Modules '// Lets simulate the VBA Input Function Public Function InputBoxDK(Prompt As String, Optional Title As String, _ Optional Default As String, _ Optional Xpos As Long, _ Optional Ypos As Long, _ Optional Helpfile As String, _ Optional Context As Long) As String Dim lngModHwnd As Long, lngThreadID As Long '// Lets handle any Errors JIC! due to HookProc> App hang! On Error GoTo ExitProperly lngThreadID = GetCurrentThreadId lngModHwnd = GetModuleHandle(vbNullString) hHook = SetWindowsHookEx(WH_CBT, AddressOf NewProc, lngModHwnd, lngThreadID) If Xpos Then InputBoxDK = InputBox(Prompt, Title, Default, Xpos, Ypos, Helpfile, Context) Else InputBoxDK = InputBox(Prompt, Title, Default, , , Helpfile, Context) End If ExitProperly: UnhookWindowsHookEx hHook End Function Sub TestDKInputBox() Dim x x = InputBoxDK("أدخل كلمة المرور", "كلمة المرور") If x = "" Then End If x <> "123" Then MsgBox "كلمة المرور غير صحيحة" End End If UserForm1.Show End Sub فورم.rar

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

طبعا ممكن اجعل كود استدعاء الفورم كالاتى Sub النتائج() Dim x As Variant x = InputBox("أدخل كلمة المرور لفتح الفورم") If x = "" Then Exit Sub If x = "123" Then UserForm1.Show Else MsgBox ("كلمة المرور غير صحيحة") End If End Sub

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

أخى سعيد أخى ياسر هذا كود آخر بالحلقات التكرارية صحيح أنها تكون بطيئة قليلا فى البيانات الكبيرة ولكن وضعتها لاثراء الموضوع Sub ragab() Dim cl As Range, cll As Range Dim LR1 As Integer, LR2 As Integer Dim sh1 As Worksheet, sh2 As Worksheet '======================================== Set sh1 = Sheet1: Set sh2 = Sheet2 LR1 = sh1.Range("A10000").End(xlUp).Row LR2 = sh2.Range("A10000").End(xlUp).Row sh1.Range("E8:E" & LR1).ClearContents '======================================== For Each cll In sh2.Range("C8:C" & LR1) For Each cl In sh1.Range("B8:B" & LR1) If cll = cl Then cl.Offset(0, 3) = cll.Offset(0, 6) End If Next Next End Sub

بالنسبة لصفة الارشيف أنا فهمت المطلوب لكن بالنسبة للصفحة D لم يتضح المطلوب والأفضل ارفاق ملف به بعض البيانات فى الصفحة D والنتيجة المطلوبة

هذه صفحتى على الفيس Ragab Gaweesh

بارك الله فيك أستاذ محمد بارك الله أخى ياسر