إبراهيم ابوليله

اخى عبد العزيز اضافه جميله الى الاكواد السابقه ............................................. اخى ياسر قولتلك بالراحه شويه شويه على العموم اليك هذه الكود Sub OneDimensionalArray4() Dim Arr Arr = Array("sat", "san", "mon", "tu", "wen", "th", "fra") Arr = WorksheetFunction.Transpose(Arr) Range("A1").Resize(7, 1).Value = Arr End Sub تقبل تحياتى

اخى ياسر هذه محاوله منى Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" Range("a1") = Arr(1) Range("a2") = Arr(2) Range("a3") = Arr(3) Range("a4") = Arr(4) Range("a5") = Arr(5) Range("a6") = Arr(6) Range("a7") = Arr(7) End Sub Sub OneDimensionalArray2() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" For g = 1 To UBound(Arr) Cells(g, 1) = Arr(g) Next End Sub Sub OneDimensionalArray3() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" For i = LBound(Arr) To UBound(Arr) Cells(i, 1) = Arr(i) 'MsgBox Arr(i) Next End Sub تقبل تحياتى

ماشى ياعم ياسر قصدك كده يعنى Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" Cells(1, 1).Resize(1, 7) = Arr End Sub تقبل تحياتى

اخى الحبيب ياسر ايضا بالاستعانه الى فكره الوصول الى اخر رقم عن طريق UBound يصبح شكل الكود كالاتى Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" For g = 1 To UBound(Arr) Cells(1, g) = Arr(g) Next End Sub تقبل تحياتى اخى الحبيب ياسر ايضا بالاستعانه الى فكره الوصول الى اول رقم LBound واخر رقم عن طريق UBound يصبح شكل الكود كالاتى Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" For i = LBound(Arr) To UBound(Arr) Cells(1, i) = Arr(i) 'MsgBox Arr(i) Next End Sub تقبل تحياتى

اخى واستاذى ياسر مشكورا على الترحيب ولكن بالراحه عليا انا فى المصفوفات عامل زى شعبوله التعبوله ولكن دى محاوله منى Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" Range("a1") = Arr(1) Range("b1") = Arr(2) Range("c1") = Arr(3) Range("d1") = Arr(4) Range("e1") = Arr(5) Range("f1") = Arr(6) Range("g1") = Arr(7) End Sub تقبل تحياتى

السلام عليكم ورحمة الله وبركاته اخى واستاذى ياسر مشكورا على الموضوع الشيق والممتع بجد ان متأكد ان شاء الله الاستفاده ستكون كبيره زادك الله من فضله وعلمه ................................ واسمح لى بالاجابه على السؤال Sub OneDimensionalArray() Dim Arr(1 To 7) As String Arr(1) = "sat" Arr(2) = "san" Arr(3) = "mon" Arr(4) = "tu" Arr(5) = "wen" Arr(6) = "th" Arr(7) = "fra" MsgBox LBound(Arr) MsgBox UBound(Arr) End Sub تقبل تحياتى

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

اخى خالد هل تقصد هكذا سوف يتم تناول الاكواد الخاصه بالمالتى بيدج تقبل تحياتى

استاذ سليم منور المشاركه تقبل تحياتى

اخى محمد بالفعل الكود الذى تفضلت به صحيح ويمكن ايضا مسح الخليه دون التحديد Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("g14:g14")) Is Nothing Then Target.Offset(1, 0).Value = Target.Value + Target.Offset(1, 0).Value Range("G14").ClearContents End If End Sub او Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("g14:g14")) Is Nothing Then Target.Offset(1, 0).Value = Target.Value + Target.Offset(1, 0).Value Target.Value="" End If End Sub تقبل تحياتى

وعليكم السلام وررحمة الله وبركاته اخى محمد ضع هذه الكود فى حدث الورقه Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, Range("G14:G14")) Is Nothing Then Target.Offset(1, 0).Value = Target.Value + Target.Offset(1, 0).Value End If End Sub تقبل تحياتى

اخى خالد درس جميل وشيق تقبل تحياتى

اخى اكرم هل تقصد هكذا تقبل تحياتى حذف المسافات الزائدة.rar

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

اخى محمد حسن مشكورا على الدعاء الجميل تقبل تحياتى

اخى واستاذنا محمد صالح منور المشاركه كلها وبالفعل كان هناك خطأ بالمعادله فى العمود B .................................................... واود التنبيه الى انه يمكن ايضا استخدام المعادله الاتيه فى العمود C فى شيت TEN =IF($B10="","",INDEX(hom!$C$6:$C$63,MATCH(ten!$B10,hom!$B$6:$B$63,0),COLUMN()-2)) واستخدام المعادله الاتيه فى العمود F فى شيت TEN =IF($B10="","",INDEX(hom!$F$6:$F$63,MATCH(ten!$B10,hom!$B$6:$B$63,0),COLUMN()-5)) تقبل تحياتى

اخى محمد الريفى موضوع جميل مهم جدا مشكورا على تقديم للمواضيع ذات الاهميه ................................... اخى سليم منور المشاركه وطبعا دائما ما نستفيد من مشاركاتك ........................................... اسمحو لى بالمشاركه ببعض المعادلات التى تؤدى نفس الغرض .............................................. المعادله الاولى =LOOKUP(100000000000000,C7:C12) المعاله الثانيه =VLOOKUP(100000000000000,C7:C12,1) المعاله الثالثه معادلة صفيف =INDEX(C7:C12,MIN((ROW(C7:C12)-ROWS($1:6))*SUMPRODUCT((C7:C12<>"")*(C7:C12<>"")))) المعادله الرابعه =INDEX(C7:C12,MATCH(9.99999999999999E+307,C7:C12)) المعادله الخامسه =INDEX(C7:C12, COUNTA(C7:C12), 1) المعادله السادسه =OFFSET(C6,MATCH(MAX(C7:C12)+1,C7:C12,1),0) المعادله السابعه =LOOKUP(2,1/(C7:C12<>""),C7:C12) المعادله الثامنه =LOOKUP(2,1/NOT(ISBLANK(C7:C12)),C7:C12) تقبلو تحياتى

بعد اذن اخى محمد ......................... الاخت رنده فقط ضعى هذه المعادله فى الخليه c10 فى شيت ten ثم قومى بسحب المعادله =IF($B10="","",INDEX(hom!$C$6:$C$63,MATCH(ten!$B10,hom!$B$6:$B$63,0))) ثم ضعى هذه المعادله فى الخليه f10 فى شيت ten ثم قومى بسحب المعادله ...................................... هذه محاوله منى على حسب فهمى للمطلوب ................... تقبلو تحياتى

اخى ابو الياس اشكرك على الدعاء تقبل تحياتى

أخي الحبيب إبراهيم أبو ليله المحترم ...لا عليك ...فإن لك أخاً أكبرمنك سناً....أحب أن يداعبك بكلمات أعتذر إن كنت قد أثقلت عليك أعلم يقيناً أنك تحب مساعدة الآخرين وأنك أهل لحل هذه المسائل التي نعتبرها نحن المبتدئين معضلة تقبل تحياتي والسلام عليكم. اخى محمد شرف لى مداعبتك لى وكل عام وانت بخير تقبل تحياتى

اخى محمد حسن بالفعل اعتزر على الخطأ الذى حدث وقد تم التعديل فى المشاركه رقم 2 تقبل تحياتى

اخى ابو الياس هذه محاوله منى اتمنى ان تفى بالغرض اذا كان المحاوله ناجحه يرجى قفل الموضوع باختيار افضل اجابه ولا تنسى ان تضغط على محتوى اعجبنى تقبل تحياتى لست بوكس.rar

أخى خالد الموضوع بصراحه جميل جدا ................................... بس انا شايف انك بكده بدأت تخرج عن مضمون العنوان ....................................................... ايه رأيك لو تناشد احد المشرفين لنقل المشاركه 89 الى موضوع جديد يكون باسم index انا شايف ان كده هيكون افضل ................................. على العموم ده مجرد رأى ............................ تقبل تحياتى

اخى ابا اسمعاعيل اذا كان الحل مناسب اختار افضل اجابه لغلق الموضوع ولا تنسى ان تضغط على محتوى اعجبنى تقبل تحياتى

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