نجوم المشاركات

Try Sub Test() Dim lr As Long With ActiveSheet lr = .Cells(Rows.Count, 1).End(xlUp).Row ConvertData .Range("A1:D" & lr), .Range("H1") End With End Sub Public Sub ConvertData(ByVal sourceRange As Range, ByVal targetCell As Range) Const NAME_COL As Long = 2, MONTH_COL As Long = 3 Dim vName, vMonth, outputRange As Range, dicName As Object, dicMonth As Object, i As Long Set dicName = CreateObject("Scripting.Dictionary") Set dicMonth = CreateObject("Scripting.Dictionary") For i = 2 To sourceRange.Rows.Count If Not dicName.Exists(sourceRange(i, NAME_COL).Value) Then dicName.Add sourceRange(i, NAME_COL).Value, dicName.Count + 1 End If If Not dicMonth.Exists(sourceRange(i, MONTH_COL).Value) Then dicMonth.Add sourceRange(i, MONTH_COL).Value, dicMonth.Count + 1 End If Next i Set outputRange = targetCell.Resize(dicName.Count + 1, dicMonth.Count + 2) outputRange.Cells(1, 1).Value = "S" outputRange.Cells(1, 2).Value = "Name" For Each vMonth In dicMonth.Keys outputRange.Cells(1, dicMonth(vMonth) + 2).Value = vMonth Next vMonth For Each vName In dicName.Keys outputRange.Cells(dicName(vName) + 1, 1).Value = dicName(vName) outputRange.Cells(dicName(vName) + 1, 2).Value = vName For Each vMonth In dicMonth.Keys For i = 2 To sourceRange.Rows.Count If sourceRange(i, NAME_COL).Value = vName And sourceRange(i, MONTH_COL).Value = vMonth Then outputRange.Cells(dicName(vName) + 1, dicMonth(vMonth) + 2).Value = sourceRange(i, 4).Value Exit For End If Next i Next vMonth Next vName End Sub

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

السلام عليكم ورحمة الله وبركاته إن أذن لي أخي الكريم @محي الدين ابو البشر لإثراء الموضوع قمت بحله بطريقتين : طريقة الجداول المحورية دمج الجداول المحورية بالمعادلات في جدول كلتيهما بحاجة تحديث فقط . أرجو لكم جميعاً التوفيق والسداد والسلام عليكم Abu Rafat.xlsx

RAFAT.xlsm

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

السلام عليكم عملت برنامج سلف للموظفين بس في حاجة مش مظبوطة مني براجعت كذا مرة بس للاسف لم اوفق ارجو المساعدة في سد الثغرة الموجودة خالص تحياتي S&M.rar

السلام عليكم جرب الملف كلمة السر 123 الزمن 50 ثانية يمكن تعديلها من الكود توقيت.xlsm

وعليكم السلام ورحمة الله وبركاته طلبك غير واضح بالنسبة لي هل تريد اخفاء الليبل فقط ام يتم معه اخفاء التكست بوكس ايضا علي كل حال اليك ملف اخفاء الليبل فقط اخفاء الليبل.xlsm وهذا اخفاء الليبل مع التكست بوكس الاثنين اخفاء الليبلوالتكست.xlsm واختر ما يخقق طلبك تحياتي

السلام عليكم .. وتقبل الله كمنا ومنكم الصيام والقيام ايه الاحبه عندي الملف المرفق المطلوب تكرما هو 1- اريد شيت (المقسطون) يأخذ القسط من شيت (تسديد العمل) وولتوضيح (1-2 ) رمز للمطلوب حسب الشهر 2- التسديدات فيها مشكلة عنما نقلتها للملف هذا .. اما الاصل فهي شغاله ( احتمالية عدم نقيل الاكواد الخاصه بها ) ويرمز له ( 3 ) دمتم بخير وعافية الزكاة الخاصة للارسال.xls

الحمد لله الذي بنعمته تتم الصالحات لا شكر على واجب حياكم الله

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

باركود الصنف + اسم الصنف مفتاح اساسي عند وضع صنف موجود مسبقا تاتى هذه الرسالة يرجى تغيير الرسالة الى (هذا الصنف موجود مسبقا) يرجى شرح الطريقة للتعلم فضلا مع التعديل على القاعدة وشكرا Database1.accdb

@محمد احمد لطفى والجميل فى الكود انه لا يلزم ان يكون جقل اسم الصنف مقتاح اساسى فى الجدول

Function NoToTxt(TheNo As Double, MyCur As String, MySubCur As String) As String Dim MyArry1(0 To 9) As String Dim MyArry2(0 To 9) As String Dim MyArry3(0 To 9) As String Dim Myno As String Dim GetNo As String Dim RdNo As String Dim My100 As String Dim My10 As String Dim My1 As String Dim My11 As String Dim My12 As String Dim GetTxt As String Dim Mybillion As String Dim MyMillion As String Dim MyThou As String Dim MyHun As String Dim MyFraction As String Dim MyAnd As String Dim i As Integer Dim ReMark As String If TheNo > 999999999999.99 Then Exit Function If TheNo < 0 Then TheNo = TheNo * -1 ReMark = "يتبقى لكم " Else ReMark = "فقط " End If If TheNo = 0 Then NoToTxt = "صفر" Exit Function End If MyAnd = " و" MyArry1(0) = "" MyArry1(1) = "مائة" MyArry1(2) = "مائتان" MyArry1(3) = "ثلاثمائة" MyArry1(4) = "أربعمائة" MyArry1(5) = "خمسمائة" MyArry1(6) = "ستمائة" MyArry1(7) = "سبعمائة" MyArry1(8) = "ثمانمائة" MyArry1(9) = "تسعمائة" MyArry2(0) = "" MyArry2(1) = " عشر" MyArry2(2) = "عشرون" MyArry2(3) = "ثلاثون" MyArry2(4) = "أربعون" MyArry2(5) = "خمسون" MyArry2(6) = "ستون" MyArry2(7) = "سبعون" MyArry2(8) = "ثمانون" MyArry2(9) = "تسعون" MyArry3(0) = "" MyArry3(1) = "واحد" MyArry3(2) = "اثنان" MyArry3(3) = "ثلاثة" MyArry3(4) = "أربعة" MyArry3(5) = "خمسة" MyArry3(6) = "ستة" MyArry3(7) = "سبعة" MyArry3(8) = "ثمانية" MyArry3(9) = "تسعة" '====================== GetNo = Format(TheNo, "000000000000.00") i = 0 Do While i < 15 If i < 12 Then Myno = Mid$(GetNo, i + 1, 3) Else Myno = "0" + Mid$(GetNo, i + 2, 2) End If If (Mid$(Myno, 1, 3)) > 0 Then RdNo = Mid$(Myno, 1, 1) My100 = MyArry1(RdNo) RdNo = Mid$(Myno, 3, 1) My1 = MyArry3(RdNo) RdNo = Mid$(Myno, 2, 1) My10 = MyArry2(RdNo) If Mid$(Myno, 2, 2) = 11 Then My11 = "إحدى عشر" If Mid$(Myno, 2, 2) = 12 Then My12 = "إثنى عشر" If Mid$(Myno, 2, 2) = 10 Then My10 = "عشرة" If ((Mid$(Myno, 1, 1)) > 0) And ((Mid$(Myno, 2, 2)) > 0) Then My100 = My100 + MyAnd If ((Mid$(Myno, 3, 1)) > 0) And ((Mid$(Myno, 2, 1)) > 1) Then My1 = My1 + MyAnd GetTxt = My100 + My1 + My10 If ((Mid$(Myno, 3, 1)) = 1) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My11 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My11 End If If ((Mid$(Myno, 3, 1)) = 2) And ((Mid$(Myno, 2, 1)) = 1) Then GetTxt = My100 + My12 If ((Mid$(Myno, 1, 1)) = 0) Then GetTxt = My12 End If If (i = 0) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then Mybillion = GetTxt + " مليار" Else Mybillion = GetTxt + " مليارات" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " مليار" If ((Mid$(Myno, 1, 3)) = 2) Then Mybillion = " ملياران" End If End If If (i = 3) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyMillion = GetTxt + " مليون" Else MyMillion = GetTxt + " ملايين" If ((Mid$(Myno, 1, 3)) = 1) Then MyMillion = " مليون" If ((Mid$(Myno, 1, 3)) = 2) Then MyMillion = " مليونان" End If End If If (i = 6) And (GetTxt <> "") Then If ((Mid$(Myno, 1, 3)) > 10) Then MyThou = GetTxt + " ألف" Else MyThou = GetTxt + " آلاف" If ((Mid$(Myno, 3, 1)) = 1) Then MyThou = " ألف" If ((Mid$(Myno, 3, 1)) = 2) Then MyThou = " ألفان" End If End If If (i = 9) And (GetTxt <> "") Then MyHun = GetTxt If (i = 12) And (GetTxt <> "") Then MyFraction = GetTxt End If i = i + 3 Loop If (Mybillion <> "") Then If (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then Mybillion = Mybillion + MyAnd End If If (MyMillion <> "") Then If (MyThou <> "") Or (MyHun <> "") Then MyMillion = MyMillion + MyAnd End If If (MyThou <> "") Then If (MyHun <> "") Then MyThou = MyThou + MyAnd End If If MyFraction <> "" Then If (Mybillion <> "") Or (MyMillion <> "") Or (MyThou <> "") Or (MyHun <> "") Then NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + MyAnd + MyFraction + " " + MySubCur + " " + "لا غير" Else NoToTxt = ReMark + MyFraction + " " + MySubCur + " " + "لا غير" End If Else NoToTxt = ReMark + Mybillion + MyMillion + MyThou + MyHun + " " + MyCur + " " + "لا غير" End If End Function وعليكم السلام، هذا الكود تضعه في موديل ثم تكتب هذه المعادلة =NoToTxt(الرقم;العملة;أجزاء العملة)

هل تم حل المشكلة لديك ؟؟

شكراً أستاذى @kanory ربنا يبارك فيك و يحفظك

طيب الكود التالي يقوم بالاتي :::::::: - البحث عن العبارة او العبارات في الجدول سواءا كانت تلك العبارة في بداية النص او وسطها او نهايتها ومقارنتها بالجدول الاخر لجلب المرادف لها . - حذف تلك العبارة من الجدول نهائيا ...... جرب المرفق واعلمني بالنتيجة ................ علما اني استخدم الانشطة التي انت حددتها ..... Replace&add.mdb

وعليكم السلام ورحمة الله وبركاته ولكم بمثل ما دعوتم أخي الكريم وما توفيقي إلا بالله الحمد لله الذي بنعمته تتم الصالحات، تم بفضل الله تعالى تجاوز كل هذه العقبات أو المشاكل في الملف ، وحسبما فهمت منك أنك تريد قيمة القسط التالي، وقد عملت على هذا الأساس أرجو أن تكون به الفائدة المرجوة ... والله من وراء القصد والسلام عليكم ---------------------------------------------------------------- ملاحظة: لحساب القسط للشهر القادم نستخدم المعادلة التالية: =VLOOKUP(D14+1;'تسديد عميل'!$D$19:$G$58;4;0) أما لحساب القسط للشهر الحالي فقط نحذف + 1 كما يلي: =VLOOKUP(D14;'تسديد عميل'!$D$19:$G$58;4;0) يرجى استخدام هذا الملف لأنني أجريت عدة تعديلات في المعادلات بكل الشيتات لم أعلن عنها لضيق الوقت مع الاعتذار. الزكاة الخاصة للارسال (1).xls

تم ارفاق مرفق بالفعل

@محمد احمد لطفى حاولت وما زبط برجاء التعديل على القاعدة المرفقة لارى التعديل

السلام عليكم .. اخ محمد بارك الله فيك ولك .. لتوضيح. هذا الملف فقط لشخص واحد حاله خاصة وليس معه عملاء اخرون >> وتم تعديل الطلب فيشيت ( المقسطون )المراد أخذه من شيت ( تسديد العميل ) هل ممكن تطبيق ما طلبته .. وهناك مشكلة في الشاشة الرئيسية .. واسف على تأخر الرد لان كان عندي مشكلة في الدخول للموقع الزكاة الخاصة للارسال.xls

السلام عليكم تفضل التعديل استاذي العزيز تم التعديل ايضا على الجداول ارجو ان تكون التعديلات موفقة ملاحظة : يتم اختيار قيمة السلفة وعدد الاقساط وتاريخ القسط الاول ثم توليد الاقساط S&M_2.rar

استاذي راجع هذان الرابطان بيفيدوك . 1- https://solutioncenter.apexsql.com/ar/استرداد-بيانات-sql-من-جدول-محذوف-دون-وجود/ 2- https://solutioncenter.apexsql.com/ar/كيفية-استرداد-البيانات-بعد-عمليات-الت/

In standard module Private Declare Function IsNetworkAlive Lib "Sensapi" (lpdwFlags As Long) As Long Sub CheckInternetConnection() If Not IsInternetConnected() Then UserForm1.Show Application.OnTime Now + TimeValue("00:00:10"), "CheckInternetConnection" End Sub Public Function IsInternetConnected() As Boolean Dim lngAlive If IsNetworkAlive(lngAlive) = 1 Then IsInternetConnected = True End Function In workbook module Private Sub Workbook_Open() Application.OnTime Now + TimeValue("00:00:10"), "CheckInternetConnection" End Sub

الأخوة الأساتذة الكرام خواتم مباركة على الجميع ارجو منكم عمل معادلة اكسل لاستخراج اسم اليوم من هذا التنسيق ddd dd/mmm/yyyy - hh:mm AM/PM كما هو موضح في المرفق أمامكم في الملف للاهميه بدون اكواد . ان امكن ذلك مالم باكواد ولكم جزيل الشكر وفائق الاحترام والتقرير اخوكم : علي المطري وهذا المرفق: استخراج اسم اليوم.xls

وعليكم السلام ورحمه الله وبركاته يمكنك استخدام هذه المعادله =TEXT(A8,"dddd") استخراج اسم اليوم.xls

اتفضل اخى @محمد احمد لطفى التعديل TableX NameX KindX DateX محمد احمد مقاولات عامة 01/03/2023 خالد استيراد وتصدير 01/03/2023 احمد مخبز 01/03/2023 سمير مقاولات متكاملة استيراد و تصدير تسلم ايدك اخى @kanory 🌹 تقبلوا تحياتى ومرورى Replace&add_B.mdb