عبدالله بشير عبدالله

اليك الملف البحث في القائمة بالحروف.xlsm

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

اليك الملف وبه الكود اضغط غلى الزر ليعمل الكود example.xlsb

وعليكم السلام ورحمة الله وبركاته كود صغير يقوم بالامر Sub CopyCtoB_IfBlank() Dim i As Long For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row If IsEmpty(Cells(i, "B")) And Not IsEmpty(Cells(i, "C")) Then Cells(i, "B").Value = Cells(i, "C").Value End If Next i End Sub

"أخي الفاضل،السلام عليكم ورحمة الله وبركاته حسب طلبكم في المشاركة الاولى ، أرفقتُ لك ملفين منفصلين يتضمنان طريقتين لعملية الاستيراد: الطريقة الأولى: تظهر لك واجهة اختيار، تتيح لك تحديد الملف المطلوب يدوياً ثم البدء بالاستيراد. الطريقة الثانية: تتميز بالسرعة، حيث يتم استيراد البيانات مباشرة بمجرد الضغط على الزر دون ظهور أي واجهات. كلا الحلين يتوافقا تماماً مع ما طلبت، فهل قمت بتجربتهما؟ وفي حال عدم عملهما لديك، أتمنى منك تحديد المشكلة بدقة وشرحها، وستجد الحلول بإذن الله مني أو من الإخوة الأفاضل في المنتدى الذين لا يتأخرون في الدعم. أنتظر منك إجابة على هذه التساؤلات، لك وافر التقدير والاحترام

وعليكم السلام ورحمة الله وبركاته هل تعنى انك لا تريد ظهور الواجهة لاحتيار الملف وتريد الاستيراد مباشرة اليك الملف بدون ظهور الواجهة ويكون الملفان في مكان واحد وبنفس الاسماء اضغط على زر استيراد يتم احضار البيانات مباشرة ملف.zip

وعليكم السلام ورحمة الله وبركاته الكود حاليا عند التقر على الزر يقوم بفتح واجهة اختيار ملف من اي مكان في جهازك وليس ضروريا ان يكوتا في نفس المجلد حيث يقوم الكود بمسح البيانات القديمة والصاق الجديدة اليك الملف متمنيا ان تجد فيه طليك ملف.xlsb تحياتي

السلام عليكم السبب هو وجود مسافات قبل الارقام وهذا يحدث عادة عند نسح ارقام ناتجة عن معادلات الحل كل القيم تتحول إلى نصوص (CStr) وتُزال الفراغات (Trim) وهذا يضمن التطابق حتى لو كانت القيم أرقام أو نصوص أو ناتجة عن معادلات. اليك الكود المعدل Sub تحويل_اللجان_الى_اسماء_Turbo() Dim ws As Worksheet: Set ws = ActiveSheet Dim r As Long, c As Long Dim lastRowMain As Long, lastRowSearch As Long Dim رقم_اللجنة As String, اسم_اللجنة As String, اسم_المراقب As String Dim فارق_الاعمدة As Long: فارق_الاعمدة = 12 Dim cell As Range lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row ws.Range("P3:X" & lastRowSearch).ClearContents lastRowMain = ws.Cells(ws.Rows.Count, "B").End(xlUp).Row lastRowSearch = ws.Cells(ws.Rows.Count, "N").End(xlUp).Row For r = 3 To lastRowMain اسم_المراقب = Trim(CStr(ws.Cells(r, "B").Value)) For c = 4 To 12 رقم_اللجنة = Trim(CStr(ws.Cells(r, c).Value)) If رقم_اللجنة <> "" Then For Each cell In ws.Range("C3:C" & lastRowMain) If Trim(CStr(cell.Value)) = رقم_اللجنة Then اسم_اللجنة = Trim(CStr(ws.Cells(cell.Row, "B").Value)) Dim صف_المراقب As Range For Each صف_المراقب In ws.Range("N3:N" & lastRowSearch) If Trim(CStr(صف_المراقب.Value)) = اسم_المراقب Then ws.Cells(صف_المراقب.Row, c + فارق_الاعمدة).Value = اسم_اللجنة Exit For End If Next صف_المراقب Exit For End If Next cell End If Next c Next r End Sub

السلام عليكم حسب قهمي للكود الكود يتعامل مع العمود A والذي به ترقيم والمفترض التعامل مع الاسماء في العمود B اذا كان فهمي للامر صحيح اليك الكود المعدل والا قم بتوضيح الامر اكثر تصوري Sub Compare2() Dim lr As Long, i As Long, j As Long Dim strCol As String Dim WS As Worksheet: Set WS = Worksheets("Data") Dim hasMissing As Boolean: hasMissing = False Application.ScreenUpdating = False On Error Resume Next lr = WS.Columns("B").Find(What:="*", SearchDirection:=xlPrevious).Row On Error GoTo 0 If lr < 6 Then Application.ScreenUpdating = True Exit Sub End If For i = 6 To 18 strCol = Split((WS.Columns(i).Address(, 0)), ":")(0) Dim lastInCol As Long lastInCol = WS.Cells(WS.Rows.Count, strCol).End(xlUp).Row If lastInCol < 6 Then lastInCol = 6 For j = 6 To lr If WorksheetFunction.CountIf(WS.Range(strCol & "6:" & strCol & lastInCol + 500), WS.Range("B" & j)) = 0 Then With WS.Cells(WS.Rows.Count, strCol).End(xlUp).Offset(1) .Value = WS.Range("B" & j).Value End With hasMissing = True lastInCol = lastInCol + 1 End If Next j Next i Application.ScreenUpdating = True End Sub

ولن يعمل لان ملفك ليس به اي كود ولن يقبل حفظ اي كود لانه بامتداد xlsx ولو قرأت ما شرحته لك في الرد السابق لفهمت سبب عدم عمل الملف تحياتي

وعليكم السلام ورحمة الله وبركاته حسب طلبك في الرسائل الحاصة استاذ هذا هو طلبي لقد اعادة ملف الاكسيل لقد حاولت وضع الكود ولم اسطيع الاجابة على طلبك ارجع الى اول ملف في مشاركتك الاولى اسم الملف (امتداده) يتنهي xlsx ارجع الى الملف الذي ارفقت لك به الاجابه وبه الكود اسم الملف (امتداده) يتنهي xlsb لماذا قمت انا بتغيير امتداد الملف من xlsx الى xlsb ؟ لسبب بسيط وهو ان اي ملف اكسل يتنهي اسمه (امتداده) xlsx لا يمكن ان يحفظ كود في هذه النوعية من الملفات ماذا يحدث لو وضعت كوداً في ملف xlsx؟ إذا قمت بوضع كود داخل ملف xlsx ثم قمت بالحفظ: ستظهر لك رسالة تنبيه واضحة. إذا ضغطت "نعم" (Yes) للحفظ بصيغة xlsx فسيقوم إكسل بمسح الكود تماماً. عند فتح الملف مرة أخرى، لن تجد أي أثر للكود الذي كتبته. وملفك الاخير بنفس الامتداد xlsx فلن يتم حفظ الكود لذلك عند حفظ الملف وظهور رسالة التنبيه احتيار لا بدل نعم كما في الصور المرفقة اليك الملف وبه الكود بغد تحويله من xlsx الى xlsb وهو نفس الملف في احر مشاركة لي Employees.xlsb

السلام عليكم تم التعديل ومسح البيانات للنطاق b7:h7 بعد الترحيل مع التسطير كذلك تم اظافة شرط وهو اذا كانت الخلايا في النطاق b7:h7 فارغة لا يتم الترحيل Employees5.xlsb

وعليكم السلام ورحمة الله وبركاته كنت اتمنى دعم طلبك ببياتات لتتضح الصورة اكثر طلبك فيه بعض الغموض بالنسبة لي وهذا الغموض في شيت حجز التوقيت فهل الصفوف 8-9-10-11 بها بيانات وترحل ام لا افترضت ان الصفوف المراد ترحيلها الرابع والسابع مبدئيا جرب الكود في الملف المرفق فاذا كان ليس طلبك حدد طلبك بالتفصيل مدعما بملف به البيانات المراد ترحيلها Employees5.xlsb

جرب التعديل التالي test2.xlsm

حسب فهمي لسؤالك في الكود المعدل الكود يقرأ عمود التاريخ كرقم وللتوضيح اكثر التواريخ هي في الأصل أرقام (مثلاً تاريخ اليوم هو رقم مثل 46040)، والتنسيق الذي تراه dd/mm/yyyy هو مجرد "قناع" أو مظهر خارجي لتسهيل القراءة علينا كبشر. في الكود توجد الدالة CDbl(.Range("J3").Value)، بحيث يأحد "القيمة الرقمية" الحقيقية المخزنة داخلها. وباحتصار الكود الآن يرى التاريخ كقيمة رقمية مجردة، بغض النظر عن طريقة تنسيق التاريخ في خلايا الجدول (سواء كانت yyyy/mm/dd أو dd-mm-yy). ويمكنك تجربة تبديل بعض التواريح بتغيير التنسيق في الجدول كمثال جعل 15/04/2026 الى 04/15/2026 فالنتيجة واحدة تحياتي