سيف الدين ابو باسم قام بنشر ديسمبر 19, 2016 مشاركة قام بنشر ديسمبر 19, 2016 السلام عليكم ورحمة الله وبركاته اساتذتى الكرام الزين لايبخلون علينا بشىء وربنا يبارك فيهم اجمعين . المطلوب تجميع الاسماء الزين فى جدول ( أ ) داخل جدول ( ب ) بالترتيب اومن غير ترتيب عادى اقول الحمد لله انه يكون فى اهتماممن حضراتكم ولسيادكم جذيل الشكر . الى حضراتكم المرفق تجميع بالترتيب.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 19, 2016 مشاركة قام بنشر ديسمبر 19, 2016 وعليكم السلام Sub Test() Dim arr As Variant Dim temp As Variant Dim i As Long Dim r As Long arr = Range("B3:C36").Value ReDim temp(1 To UBound(arr, 1), 1 To 2) For i = LBound(arr, 1) To UBound(arr, 1) If Not IsEmpty(arr(i, 1)) Then r = r + 1 temp(r, 1) = arr(i, 1) temp(r, 2) = arr(i, 2) End If Next i Range("G3").Resize(r, 2).Value = temp End Sub رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 19, 2016 الكاتب مشاركة قام بنشر ديسمبر 19, 2016 استاذ ياسر ماشاءالله عليك زى ماانا طلبط بالظبط ووضعت الكود وبقى تمام بس انا لقيت انه لو فى جدول اكبر وتم وضعه على جزئين ممكن حضرتك تعدلى فى الكود والى حضرتك شكل الجدول لما يكبر تجميع اسماء.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 19, 2016 مشاركة قام بنشر ديسمبر 19, 2016 Sub Test() Dim arr1 As Variant Dim arr2 As Variant Dim temp As Variant Dim i As Long Dim r As Long arr1 = Range("B3:C36").Value arr2 = Range("E3:F36").Value ReDim temp(1 To UBound(arr1, 1) + UBound(arr2, 1), 1 To 2) For i = LBound(arr1, 1) To UBound(arr1, 1) If Not IsEmpty(arr1(i, 1)) Then r = r + 1 temp(r, 1) = arr1(i, 1) temp(r, 2) = arr1(i, 2) End If Next i For i = LBound(arr2, 1) To UBound(arr2, 1) If Not IsEmpty(arr2(i, 1)) Then r = r + 1 temp(r, 1) = arr2(i, 1) temp(r, 2) = arr2(i, 2) End If Next i Range("J3").Resize(r, 2).Value = temp End Sub رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 19, 2016 مشاركة قام بنشر ديسمبر 19, 2016 بعد إذن أخي ياسر نفس الشيء لكن بالمعادلات تجميع بالترتيب Salim.rar رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 19, 2016 الكاتب مشاركة قام بنشر ديسمبر 19, 2016 استاذ ياسر واستاذ سليم انا بشكر حضرتكم على الاهتمام وبارك الله فيكم بس في توضيح للكود الخاص بالاستاذ ياسر انه لما الاسماء بتزيد فى الجدول ( أ ) بتنزل عن حد الجدول ( ب ) يعنى مش بتلف مع تسلسل الجدول والى حضرتك المرفق بعد وضع الكود والخروج عن الجدول . 2تجميع اسماء.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 20, 2016 مشاركة قام بنشر ديسمبر 20, 2016 Sub Test() Dim arr1 As Variant Dim arr2 As Variant Dim temp As Variant Dim varTemp1 As Variant Dim varTemp2 As Variant Dim i As Long Dim r As Long Dim x As Long arr1 = Range("B3:C36").Value arr2 = Range("E3:F36").Value ReDim temp(1 To UBound(arr1, 1) + UBound(arr2, 1), 1 To 2) For i = LBound(arr1, 1) To UBound(arr1, 1) If Not IsEmpty(arr1(i, 1)) Then r = r + 1 temp(r, 1) = arr1(i, 1) temp(r, 2) = arr1(i, 2) End If Next i For i = LBound(arr2, 1) To UBound(arr2, 1) If Not IsEmpty(arr2(i, 1)) Then r = r + 1 temp(r, 1) = arr2(i, 1) temp(r, 2) = arr2(i, 2) End If Next i If r > 34 Then ReDim varTemp1(1 To 34, 1 To 2) For i = 1 To 34 varTemp1(i, 1) = temp(i, 1) varTemp1(i, 2) = temp(i, 2) Next i Range("J3").Resize(34, 2).Value = varTemp1 ReDim varTemp2(35 To UBound(temp, 1), 1 To 2) For i = 35 To UBound(temp, 1) varTemp2(i, 1) = temp(i, 1) varTemp2(i, 2) = temp(i, 2) Next i Range("M3").Resize(r - 34, 2).Value = varTemp2 Else Range("J3").Resize(r, 2).Value = temp End If End Sub 1 رابط هذا التعليق شارك More sharing options...
سليم حاصبيا قام بنشر ديسمبر 20, 2016 مشاركة قام بنشر ديسمبر 20, 2016 19 دقائق مضت, ياسر خليل أبو البراء said: Sub Test() Dim arr1 As Variant Dim arr2 As Variant Dim temp As Variant Dim varTemp1 As Variant Dim varTemp2 As Variant Dim i As Long Dim r As Long Dim x As Long arr1 = Range("B3:C36").Value arr2 = Range("E3:F36").Value ReDim temp(1 To UBound(arr1, 1) + UBound(arr2, 1), 1 To 2) For i = LBound(arr1, 1) To UBound(arr1, 1) If Not IsEmpty(arr1(i, 1)) Then r = r + 1 temp(r, 1) = arr1(i, 1) temp(r, 2) = arr1(i, 2) End If Next i For i = LBound(arr2, 1) To UBound(arr2, 1) If Not IsEmpty(arr2(i, 1)) Then r = r + 1 temp(r, 1) = arr2(i, 1) temp(r, 2) = arr2(i, 2) End If Next i If r > 34 Then ReDim varTemp1(1 To 34, 1 To 2) For i = 1 To 34 varTemp1(i, 1) = temp(i, 1) varTemp1(i, 2) = temp(i, 2) Next i Range("J3").Resize(34, 2).Value = varTemp1 ReDim varTemp2(35 To UBound(temp, 1), 1 To 2) For i = 35 To UBound(temp, 1) varTemp2(i, 1) = temp(i, 1) varTemp2(i, 2) = temp(i, 2) Next i Range("M3").Resize(r - 34, 2).Value = varTemp2 Else Range("J3").Resize(r, 2).Value = temp End If End Sub بعد إذن أخي ياسر نفس الشيء لكن بالمعادلات صباح الخير أخي ياسر انا لا ارى ان هناك لزوماً للمصفوفات يكفي هذا الكود Sub Tajmi3() lr = Application.Max(Range("a:a")) + 2 Range("b3:b" & lr).SpecialCells(xlCellTypeConstants).Copy Range("j3") Range("c3:c" & lr).SpecialCells(xlCellTypeConstants).Copy Range("k3") Range("e3:e" & lr).SpecialCells(xlCellTypeConstants).Copy Range("m3") Range("f3:f" & lr).SpecialCells(xlCellTypeConstants).Copy Range("n3") End Sub رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 20, 2016 مشاركة قام بنشر ديسمبر 20, 2016 لاحظ في الملف المرفق الأخير عدم وجود مبالغ مع بعض الأسماء رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 20, 2016 الكاتب مشاركة قام بنشر ديسمبر 20, 2016 السلام عليكم ورحمة الله وبركاته انا بشكر الاستاذ العظيم ياسر خليل والاستاذ سليم حاصبيا على المجهود العظيم وبقول ان الكود الخاص بالاستاذ ياسر دقيق جدا وفعلا هو المطلوب ولا انكر مجهود الاستاذ سليم بس هو فى مشكله بالكود الخاص بالاستاذ سليم انه بعض الاسماء غير متوافقه مع المبلغ خصوصا انه فى اسماء بدون مبلغ وبرجع واقول الله يباركلكم على مجهودكم معايا وشكرا . 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 20, 2016 مشاركة قام بنشر ديسمبر 20, 2016 وعليكم السلام ورحمة الله وبركاته الحمد لله الذي بنعمته تتم الصالحات ، والحمد لله أن تم المطلوب على خير أخي الكريم سيف الدين رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 21, 2016 الكاتب مشاركة قام بنشر ديسمبر 21, 2016 السلام عليكم ورحمة الله وبركاته يااستاذ ياسر الكود الخاص بحضرتك زى ماقولت سليم 100% بس انا لما جيت اوضعه داخل الملف الاصلى الخاص بعملى مش عايز يظبط معايا ممكن لو تكرمت تساعدنى فى وضعه ولسيادتكم جزيل الشكر والتقدير والى حضرتك الملف الاصلى . تجربة استقطاعات.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 21, 2016 مشاركة قام بنشر ديسمبر 21, 2016 وعليكم السلام Sub Test() Dim arr1 As Variant Dim arr2 As Variant Dim temp As Variant Dim varTemp1 As Variant Dim varTemp2 As Variant Dim i As Long Dim r As Long Dim x As Long arr1 = Range("B55:F234").Value arr2 = Range("H55:L234").Value ReDim temp(1 To UBound(arr1, 1) + UBound(arr2, 1), 1 To 5) For i = LBound(arr1, 1) To UBound(arr1, 1) If Not IsEmpty(arr1(i, 2)) Then r = r + 1 temp(r, 1) = arr1(i, 1) temp(r, 2) = arr1(i, 2) temp(r, 5) = arr1(i, 5) End If Next i For i = LBound(arr2, 1) To UBound(arr2, 1) If Not IsEmpty(arr2(i, 2)) Then r = r + 1 temp(r, 1) = arr2(i, 1) temp(r, 2) = arr2(i, 2) temp(r, 5) = arr2(i, 5) End If Next i If r > 180 Then ReDim varTemp1(1 To 180, 1 To 5) For i = 1 To 34 varTemp1(i, 1) = temp(i, 1) varTemp1(i, 2) = temp(i, 2) varTemp1(i, 5) = temp(i, 5) Next i Range("O55").Resize(180, 5).Value = varTemp1 ReDim varTemp2(181 To UBound(temp, 1), 1 To 5) For i = 181 To UBound(temp, 1) varTemp2(i, 1) = temp(i, 1) varTemp2(i, 2) = temp(i, 2) varTemp2(i, 5) = temp(i, 5) Next i Range("U55").Resize(r - 180, 5).Value = varTemp2 Else Range("O55").Resize(r, 5).Value = temp End If End Sub 1 رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 22, 2016 الكاتب مشاركة قام بنشر ديسمبر 22, 2016 بارك الله فيك يااستاذ ياسر وهو المطلوب فعلا وجعلك الله دائما فى عون المحتاجين ومساعدتك لنا دائما وانا شاكر تقدير سيادتكم . 1 رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 22, 2016 الكاتب مشاركة قام بنشر ديسمبر 22, 2016 السلام عليكم يااستاذ ياسر انا وضعت الكود وتمام زيل الفل بارك الله فيك بس فيه عيب الجدول الاول يوجد به معادلة vlookup والكود بيشوفها على انها اسم داخل الخليه مع ان الخليه فاضيه برجاء خليه يتجاهل المعادلات ولا يتعامل معها على انها شيئ داخل الخليه انا عارف ان حضرتك تعبت معى برجاء النظر . رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 22, 2016 مشاركة قام بنشر ديسمبر 22, 2016 وعليكم السلام لم أفهم المشكلة بشكل واضح ..ارفق ملف معبر عن الملف الأصلي رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 22, 2016 الكاتب مشاركة قام بنشر ديسمبر 22, 2016 السلام عليكم يااستاذ ياسر انا وضعت الى حضرتك ملف معبر عن الاصل ووضعت به الكود وحضرتك سوف تلاحظ الناتج . تجربة مرتب.rar رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 23, 2016 مشاركة قام بنشر ديسمبر 23, 2016 وعليكم السلام يوجد سطرين بالكود بهذا الشكل If Not IsEmpty(arr1(i, 2)) Then قم باستبدالهما بهذا الشكل If arr1(i, 2) <>"" Then انتبه بالنسبة للسطر الثاني ستستخدم كلمة arr2 وليس arr1 ... رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 23, 2016 الكاتب مشاركة قام بنشر ديسمبر 23, 2016 السلام عليكم يااستاذ ياسر انا فعلا عاجز عن الشكر والحمدلله كله بقى تمام بفضل ربنا سبحانه وتعالى وحضرتك وبارك الله فيك وجعلك الله دائما فى عون المحتاجين . 1 رابط هذا التعليق شارك More sharing options...
ياسر خليل أبو البراء قام بنشر ديسمبر 23, 2016 مشاركة قام بنشر ديسمبر 23, 2016 وعليكم السلام الحمد لله الذي هدانا لهذا وما كنا لنهتدي لولا أن هدانا الله .. الحمدلله أن تم المطلوب على خير أخي الكريم سيف ولي نصيحة أخيرة : حاول عندما تطرح موضوع أن يكون الملف معبر عن الملف الأصلي تماماً لأن كل ملف وله طبيعته وعمله الخاص والبرمجة تستهدف الهيكلة الموجودة ، فكلما كانت المعطيات دقيقة كانت النتائج صحيحة ودقيقة تقبل وافر تقديري واحترامي رابط هذا التعليق شارك More sharing options...
سيف الدين ابو باسم قام بنشر ديسمبر 23, 2016 الكاتب مشاركة قام بنشر ديسمبر 23, 2016 عليكم السلام ورحمة الله وبركاته يااستاذ ياسر انا والله بحاول ان اتعلم يعنى بضع ملف صغير غير الاصل وبحاول ان اشغل عقلى شوية وارتب الاكواد علشان ماكنش ثقيل عليكم يعنى بكون عايز اقل جهد من حضراتكم حتى لااحد يمل من طلبى المتكرر ولسيادتكم جذيل الشكر والتقدير . 1 رابط هذا التعليق شارك More sharing options...
الردود الموصى بها
من فضلك سجل دخول لتتمكن من التعليق
ستتمكن من اضافه تعليقات بعد التسجيل
سجل دخولك الان