ابو تميم قام بنشر أكتوبر 27, 2012 قام بنشر أكتوبر 27, 2012 تحية طيبة لجميع أعضاء منتدى أوفيسنا الكرام كل عام وأنتم بخير لدي سؤال بسيط جدا ولا يصعب على عمالقة هذا الصرح العظيم في الملف المرفق العمود A5 إلى A3005 مرتبة تسلسليا من 1 إلى 3000 والخلايا (I5:L5 ) من نفس الصف مرتبطة مع هذه الخلية كما يلي: الكود الذي تعمل عليه هذه الخلايا ( جاهز مثال في محرر الاكواد ) يعمل على جلب البيانات من ملف اكسل في موقع آخر على الجهاز كما هو موضح في المثال ، حيث يتم جلب البيانات بناء على قيمة الخلية في العمود A في نفس الصف ويجب تطبيق هذه المعادلة على جميع الخلايا الملونة ( A5:L3005 ) تم تطبيق المعادلة ( الكود ) على الصف 5 كما هو موضح وأرغب بتطبيقه على باقي الصفوف ولكن بالتعديل على الكود بحيث يتم ربط الخلايا في الأعمدة ( I : L ) مع الخلية A من نفس الصف بدون إعادة كتابة معادلة لكل صف بقيمة الخلية في العمود A وجزاكم الله خيرا اكمال كود.rar
عبدالله باقشير قام بنشر أكتوبر 28, 2012 قام بنشر أكتوبر 28, 2012 السلام عليكم على السريع اربط الكود التالي بزر للتجربة جربه على 5 صفوف كما هو معمول بالكود ادناه اذا مشى الحال معاك زيد الصفوف حسب مبتغاك Sub KH_START() Dim r As Integer For r = 5 To 10 If Cells(r, "A") <> "" And Cells(r, "A") > 0 Then Cells(r, "I") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$E$11" Cells(r, "J") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$G$11" Cells(r, "K") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$A$15" Cells(r, "L") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$F$11" Else Range("I" & r).Resize(1, 4).ClearContents End If Next End Sub
ابو تميم قام بنشر أكتوبر 28, 2012 الكاتب قام بنشر أكتوبر 28, 2012 أستاذنا الكبير عبد الله باقشير جزاك الله خيرا الكود يعمل بشكل ممتاز ولكن عند تطبيقه على جميع الصفوف والتي عددها 3000 صف أصبح تطبيق الأمر يأخذ وقتا طويلا هل يمكن التعديل على الكود بحيث يتم تطبيقه على الصف الذي نقف عليه فقط لأنه بالتأكيد لن يمسح عن الصفوف السابقة لأنها تحتوي على رقم في الخلية "A" في كل منها شكرا جزيلا وجزاكم الله خيرا
عبدالله باقشير قام بنشر أكتوبر 28, 2012 قام بنشر أكتوبر 28, 2012 أستاذنا الكبير عبد الله باقشير جزاك الله خيرا الكود يعمل بشكل ممتاز ولكن عند تطبيقه على جميع الصفوف والتي عددها 3000 صف أصبح تطبيق الأمر يأخذ وقتا طويلا هل يمكن التعديل على الكود بحيث يتم تطبيقه على الصف الذي نقف عليه فقط لأنه بالتأكيد لن يمسح عن الصفوف السابقة لأنها تحتوي على رقم في الخلية "A" في كل منها شكرا جزيلا وجزاكم الله خيرا Private Sub Worksheet_Selectionchange(ByVal Target As Range) Dim r As Integer If Not Intersect(Target, Range("A5:A3000")) Is Nothing Then r = Target.Row If Cells(r, "A") <> "" And Cells(r, "A") > 0 Then Cells(r, "I") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$E$11" Cells(r, "J") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$G$11" Cells(r, "K") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$A$15" Cells(r, "L") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$F$11" Else Range("I" & r).Resize(1, 4).ClearContents End If End If End Sub
ابو تميم قام بنشر أكتوبر 28, 2012 الكاتب قام بنشر أكتوبر 28, 2012 (معدل) أستاذنا الكبير عبد الله باقشير جزاك الله خيرا طبقت الكود وهو يعمل بشكل ممتاز جدا وكما طلبته تماما ولكن يلزم تعديل بسيط جدا بعد إذنكم الكود يعمل معي ويتم نسخ المعادلات اللازمة لجلب البيانات هل يمكن تعديل بسيط بأن يتم ربط الكود بزر يتم الضغط عليه فيتم تنفيذ الكود وليس بشكل تلقائي وذلك لأنه أولا يجب أن يتم إنشاء الملف الذي سيتم جلب البيانات منه ثم يتم إدراج المعادلة ليكون الملف الهدف موجود أصلا أما في الحالة الحالية يتم وضع المعادلة قبل إنشاء الملف الهدف وجزاكم الله خيرا تم تعديل أكتوبر 28, 2012 بواسطه ابو تميم
عبدالله باقشير قام بنشر أكتوبر 28, 2012 قام بنشر أكتوبر 28, 2012 أستاذنا الكبير عبد الله باقشير جزاك الله خيرا طبقت الكود وهو يعمل بشكل ممتاز جدا وكما طلبته تماما ولكن يلزم تعديل بسيط جدا بعد إذنكم الكود يعمل معي ويتم نسخ المعادلات اللازمة لجلب البيانات هل يمكن تعديل بسيط بأن يتم ربط الكود بزر يتم الضغط عليه فيتم تنفيذ الكود وليس بشكل تلقائي وذلك لأنه أولا يجب أن يتم إنشاء الملف الذي سيتم جلب البيانات منه ثم يتم إدراج المعادلة ليكون الملف الهدف موجود أصلا أما في الحالة الحالية يتم وضع المعادلة قبل إنشاء الملف الهدف وجزاكم الله خيرا Sub KH_START() Dim r As Integer r = ActiveCell.Row If Cells(r, "A") <> "" And Cells(r, "A") > 0 Then Cells(r, "I") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$E$11" Cells(r, "J") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$G$11" Cells(r, "K") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$A$15" Cells(r, "L") = "='D:\CCV_MOJ\data\[" & Cells(r, "A") & ".xlsb]" & Cells(r, "A") & "'!$F$11" Else Range("I" & r).Resize(1, 4).ClearContents End If End Sub
ابو تميم قام بنشر أكتوبر 28, 2012 الكاتب قام بنشر أكتوبر 28, 2012 جزاك الله خيرا أستاذنا العملاق عبد الله باقشير الكود الآن يعمل معي بشكل ممتاز جدا جزاك الله خيرا ونفع بك الأمة الإسلامية حماك الله من كل مكروه أنت والأهل أجمعين ورزقكم من حيث لا تحتسبون
عبدالله باقشير قام بنشر أكتوبر 28, 2012 قام بنشر أكتوبر 28, 2012 جزاك الله خيرا اثابك الله على دعائك لي واعطاك بمثله اضعاف مضاعفة تقبل تحياتي وشكري
الردود الموصى بها
Join the conversation
You can post now and register later. If you have an account, sign in now to post with your account.