AbuuAhmed
-
Posts
930 -
تاريخ الانضمام
-
تاريخ اخر زياره
-
Days Won
16
نوع المحتوي
المنتدى
مكتبة الموقع
معرض الصور
المدونات
الوسائط المتعددة
مشاركات المكتوبه بواسطه AbuuAhmed
-
-
أنا تخصصي أكسس أكثر منه اكسل.
أضفت 3 وحدات نمطية (موديولات) لـ أبو هادي، من له قدرة في استخدام امكانيات الاكسل في استخدام تقويم أم القرى فليفدنا.
هناك شرط يجب أن تنتبه له وهو خصائص خلايا التاريخ يجب أن تكون لتقويم أم القرى وإلا ستتفاجأ بنتائج خاطئة.- 1
-
جرب هذا الحل،
مع ملاحظة أني الحسابات على التقويم الهجري وليس أم القرى، غالبا ستكون النتائج متشابهة ما عدا نهاية الشهور ربما تكون فيها اختلاف.
جربت تجربتين خفيفتين، جربه أكثر ربما تظهر هفوات تحتاج إلى تصحيح الكود. -
حل عن طريق الـ vba، دالة لحساب أي يوم من الأسبوع بين تاريخين
-
عدلت في المعادلة ربما تعمل معك، جرب
=IF(F8*0.0199<1.99,1.99,IF(F8*0.0199>2.99,2.99,F8*0.0199))
- 1
-
الدالة، تتطلب النص وترتيب الدرجة في النص 1 للأول 2 للثاني:
Option Explicit Function GetDeg(ByVal inText As String, DegSeq As Byte) As Variant Dim Pos1 As Integer, Pos2 As Integer Dim Deg As Variant GetDeg = "" If DegSeq < 1 Or DegSeq > 2 Then Exit Function Do While InStr(1, inText, " ") > 0 inText = Replace(inText, " ", " ") Loop Pos2 = InStr(1, inText, " درج") If Pos2 = 0 Then Exit Function If DegSeq = 2 Then Pos2 = InStr(Pos2 + 1, inText, " درج") If Pos2 = 0 Then Exit Function End If Pos1 = InStrRev(inText, " ", Pos2 - 1) If Pos1 > 0 And Pos2 > 0 Then Deg = Mid(inText, Pos1 + 1, Pos2 - Pos1 - 1) End If If IsNumeric(Deg) Then GetDeg = Val(Deg) End Function
ضفه في ملفك أو انشئ ملف جديد ووحدة نمطية جديدة والصق الشفرة/الكود
- 1
-
عملت لك حل بالكود
- 2
-
طلبك الآن يخالف طلبك الأول
ربما أنك لا تريد أن ترى في الأيام الباقي 30 يوم، إذا كان كذلك اعتره شهر وأضفه على الشهور وصفر الأيام.
-
3 ساعات مضت, Engsamir Ahmed said:
لو اردت تغيير الشهر ليكون 30 يوم هل استبدل 30 ب 20
ام هناك تعيديل فى كود vba
نعم صحيح،
ولا تعديل في كودر vba -
في 8/4/2024 at 04:10, Engsamir Ahmed said:
فهل من طريقة
إذا لم تتابع فكيف نعرف حصلت على الحل أم لا!!
احتمال آخر للحل إذا كان فهمي لمطلبك صحيحا:- 2
-
-
حل آخر بدون كود vba:
=IF(RIGHT(A1,1)="-",VALUE(TRIM(LEFT(A1,LEN(A1)-1)))*-1,VALUE(TRIM(A1)))
المثال لا يوجد به أرقام بالموجب لذلك لا أضمن المعادلة ستنجح مع الأرقام الموجبة أو لا.
- 2
-
كذلك اسم النموذج مختلف فالاسم في الكود UserForm وأنت مسميه UserForm1
فالتعديل بيكون بتبديل أول سطرين من:
Private Sub UserForm_Initialize() With ListView1
إلى:
Private Sub UserForm1_Initialize() With tbl
- 1
-
تقريبا الخطأ شبيها للخطأ السابق، ولكن لو رفعت الصورة كالأولى عندما تنهي هذه الرسالة سيشير المؤشر على السطر والكائن المفقود أو اسم الكائن الخاطئ.
كذلك لو تعطيني السيناريو أي الخطوات التي أدت لظهور هذا الخطأ حتى يحدث معي وأقوم بتتبعه.
يبدو لي أنت مستقطع الكود من ملف آخر.- 1
-
لم أرى إلا نطاق tbl فاستخدمته بدلا من ListView1
كما أنه في آخر سطر مناداة لإجراء غير موجنود فعطلته actualistion.
Private Sub UserForm_Initialize() 'With ListView1 With tbl .Gridlines = True 'affiche ou pas les lignes .View = lvwReport ' style de rapport .FullRowSelect = True ' permet de sélectionner une ligne dans la liste 'création des en-tétes personnalisées avec leur largeur .ColumnHeaders.Add Text:="الرقم", Width:=1 .ColumnHeaders.Add Text:="إسم المستفيد", Width:=60 .ColumnHeaders.Add Text:="حساب المستفيد", Width:=90 .ColumnHeaders.Add Text:="البنك", Width:=60 .ColumnHeaders.Add Text:="المبلغ", Width:=60 .ColumnHeaders.Add Text:="رقم الصك", Width:=60 .ColumnHeaders.Add Text:="تاريخ إجراء المعاملة", Width:=60 End With 'Call actualistion 'on appelle la procédure qui actualise la listview End Sub
- 1
-
والله أتعبني الموضوع، أخي يفترض أن يكون سعر البيع المطلوب للبيع (متوسط الأسهم حالياً) يدخل يدويا وليس معادلة.
جرب وخبرني.- 1
-
جرب هذه المعادلة:
= ( (K6*K10) - ((K6*M7)-M6) ) / M7
-
وأينك عن هذا الموضوع؟!! ..
لا بد متابعة مواضيعك، ارجع للموضوع السابق وضع ملاحظاتك قبل فتح موضوع جديد.
-
في موضوع آخر هناك دوال لتأخذ تاريخين بداية ونهاية ثم ترجع المدة على شكل سنة شهر يوم
أما هذه الدالة تأخذ أيام فقط وتحولها إلى سنة شهر يوم، وهنا الدالة تفترض أن تاريخ البداية دائما هو بداية دورة الـ 400 سنة مثل:
1، 401، 801، 1201، 1601، 2001 وهكذا.
Function FixVal(inVal As Double, MinVal As Double, MaxVal As Double) As Double FixVal = inVal If inVal < MinVal Then FixVal = MinVal If inVal > MaxVal Then FixVal = MaxVal End Function Function Days2Period(ByVal Days As Long) As String Dim CurCal As VbCalendar Dim Gr2: Gr2 = Array(0, 31, 59, 90, 120, 151, 181, 212, 243, 273, 304, 334, 365, 396) Dim yy As Long, mm As Integer, dd As Integer Dim Cyc400 As Long, Cyc100 As Long, Cyc004 As Long, Cyc001 As Long Dim mmDays As Double, Leap As Byte CurCal = Calendar Calendar = vbCalGreg Cyc400 = Fix(Days / 146097): Days = Days - Cyc400 * 146097 Cyc100 = FixVal(Fix(Days / 36524), 0, 3): Days = Days - Cyc100 * 36524 Cyc004 = FixVal(Fix(Days / 1461), 0, 24): Days = Days - Cyc004 * 1461 Cyc001 = FixVal(Fix(Days / 365), 0, 3): Days = Days - Cyc001 * 365 yy = Cyc400 * 400 + Cyc100 * 100 + Cyc004 * 4 + Cyc001 mm = FixVal(Round(Days / 29.5, 0), 0, 11) Leap = Day(DateSerial(yy + 1, 3, 0)) - 28 mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0) Do While mmDays > Days mm = mm - 1 mmDays = Gr2(mm) + IIf(mm > 1, Leap, 0) Loop dd = Days - mmDays Days2Period = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00") Calendar = CurCal End Function
- 2
-
-
15 ساعات مضت, lionheart said:
04-11-04 04-11-00
شكرا أخي لمشاركتك الكريمة، هنا تكمن المشكلة أخي الفاضل. مشكلة ستجدها مشتركة في كل الحلول كما أعتقد.
-
دالة من "أبو هاجر"
Function GetPeriod2(ByVal DateFm As Date, ByVal DateTo As Date, _ Optional yy As Integer, Optional mm As Byte, Optional dd As Byte) As String Dim TempDate As Date Dim m As Long DateFm = DateFm - 1 m = DateDiff("m", DateFm, DateTo) TempDate = DateAdd("m", m, DateFm) If TempDate > DateTo Then m = m - 1 TempDate = DateAdd("m", m, DateFm) End If yy = Fix(m / 12) mm = m Mod 12 dd = DateDiff("d", TempDate, DateTo) GetPeriod2 = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00") End Function
دالة من جعفر
Function YMDDif(ByVal sDate1 As Date, ByVal sDate2 As Date) As String Dim iYear As Integer Dim iMonth As Integer Dim iDay As Integer Dim dInterim1 As Date Dim D As Integer Dim m As Integer Dim Y As Integer sDate1 = sDate1 - 1 iMonth = DateDiff("m", sDate1, sDate2) If day(sDate1) > day(sDate2) Then iMonth = iMonth - 1 End If dInterim1 = DateAdd("m", iMonth, sDate1) iDay = DateDiff("d", dInterim1, sDate2) Y = iMonth \ 12 m = iMonth Mod 12 D = iDay YMDDif = Format(Y, "00") & "-" & Format(m, "00") & "-" & Format(D, "00") End Function
دالة من "أبو هادي"
Function GetPeriod1(ByVal DateFm As Date, ByVal DateTo As Date, _ Optional yy As Integer, Optional mm As Byte, Optional dd As Byte) As String Dim yyFm As Long, yyTo As Long Dim mmFm As Integer, mmTo As Integer Dim ddFm As Integer, ddTo As Integer DateFm = DateFm - 1 yyFm = Year(DateFm): mmFm = month(DateFm): ddFm = day(DateFm) yyTo = Year(DateTo): mmTo = month(DateTo): ddTo = day(DateTo) If ddFm = day(DateSerial(yyFm, mmFm + 1, 1) - 1) Then ddFm = 0: mmFm = mmFm + 1 End If If ddTo = day(DateSerial(yyTo, mmTo + 1, 1) - 1) Then ddTo = 0: mmTo = mmTo + 1 End If If ddTo - ddFm < 0 Then '(1) ddTo = ddTo + day(DateSerial(yyTo, mmTo, 0)): mmTo = mmTo - 1 If ddTo - ddFm < 0 Then '(2) ddTo = ddTo + day(DateSerial(yyTo, mmTo, 0)): mmTo = mmTo - 1 End If End If If mmTo < mmFm Then mmTo = mmTo + 12: yyTo = yyTo - 1 End If yy = yyTo - yyFm mm = mmTo - mmFm dd = ddTo - ddFm GetPeriod1 = Format(yy, "00") & "-" & Format(mm, "00") & "-" & Format(dd, "00") End Function
- 1
-
كل دالة لحساب الأعمار لا تعطي هذه النتائج فهي تحتاج إلى مراجعة.
علما أن هذه النتائج من دالة تعطي ناتج طرح تاريخ من نفسه يوما واحدا وليس صفرا، ولتكون المقارنة عادلة للدوال التي تعطي صفرا عليهم بطرح يوم من تاريخ البداية.
' DateFm DateTo Period '28/02/2010 01/02/2015 04-11-05 '01/03/2010 01/02/2015 04-11-04 '02/03/2010 01/02/2015 04-11-03 '03/03/2010 01/02/2015 04-11-02 '04/03/2010 01/02/2015 04-11-01 '05/03/2010 01/02/2015 04-11-00 '06/03/2010 01/02/2015 04-10-27
جربوا دوالكم وزودونا بنائجها.
- 1
-
لا أعلم إذا يوجد في الاكسل أم لا.
هذه دالة بالـ vba يمكنها أن تؤدي الغرض:
Function Between(Value As Variant, MinVal As Variant, MaxVal As Variant) As Variant If VarType(Value) = VarType(MinVal) And _ VarType(Value) = VarType(MaxVal) Then Between = CBool(Value >= MinVal And Value <= MaxVal) Else Between = "Var type error" End If End Function
-
لا بد تدخل على تنسيق خلية المدة وتجعلها نص.
- 1
سؤال عن الفرق بين تاريخين هجري
في منتدى الاكسيل Excel
قام بنشر
ضع مثال أو صورة للخطأ
وأعتقد أنك فحصت المرفق رقم 2 وليس 3، حيث تم تبديل المرفق.
وإذا كان الخطأ في رقم 3 فأنا أعتذر عن المواصلة.