الى خبراء الاكسل برجاء المساعدة فى زيادة سرعة هذا الكود

[tefa3079]

الى خبراء الاكسل برجاء المساعدة فى زيادة سرعة هذا الكود حيث انه يؤدى الغرض المطلوب لكن ببطئ فهل يمكن تحديد المدى بخطوة واحدة بدلا من تكرارها20 مرة.

R = Application.WorksheetFunction.CountA(Sheet13.[C4:C100000]) + 4

For C = 3 To 8

Sheet13.Cells(R, C) = Cells(6, C)

Sheet13.Cells(R + 1, C) = Cells(7, C)

Sheet13.Cells(R + 2, C) = Cells(8, C)

Sheet13.Cells(R + 3, C) = Cells(9, C)

Sheet13.Cells(R + 4, C) = Cells(10, C)

Sheet13.Cells(R + 5, C) = Cells(11, C)

Sheet13.Cells(R + 6, C) = Cells(12, C)

Sheet13.Cells(R + 7, C) = Cells(13, C)

Sheet13.Cells(R + 8, C) = Cells(14, C)

Sheet13.Cells(R + 9, C) = Cells(15, C)

Sheet13.Cells(R + 10, C) = Cells(16, C)

Sheet13.Cells(R + 11, C) = Cells(17, C)

Sheet13.Cells(R + 12, C) = Cells(18, C)

Sheet13.Cells(R + 13, C) = Cells(19, C)

Sheet13.Cells(R + 14, C) = Cells(20, C)

Sheet13.Cells(R + 15, C) = Cells(21, C)

Sheet13.Cells(R + 16, C) = Cells(22, C)

Sheet13.Cells(R + 17, C) = Cells(23, C)

Sheet13.Cells(R + 18, C) = Cells(24, C)

Sheet13.Cells(R + 19, C) = Cells(25, C)

[طارق محمود]

السلام عليكم

مرحبا بك اخي الكريم بين إخوانك

تقصد تقليل حجم الكود

يمكن استبداله بالتالي

For C = 3 To 8

	For i = 0 To 19

    	Sheet13.Cells(R + i, C) = Cells(i + 6, C)

	Next i

Next C

[tefa3079]

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

[طارق محمود]

السلام عليكم

يجوز ان ذلك بسبب أن

تتابع الأوامر في الكود يجعل الإكسل عند كل خطوة يقوم بأكثر من عملية

(1) يقرأ من خلية الورقة الحالية

(2) يذهب للورقة Sheet13

(3) يجعل قيمة خلية معينة فيها تساوي تلك الخلية

(4) يرجع مرة أخري للورقة الحالية

إذا غيرنا تتابع الأوامر كالتالي

(1) يقرأ جميع الخلايا المطلوبة من الورقة الحالية ويسجلها في متغير مثلا

x(a,b)

(2) يذهب للورقة Sheet13 مرة واحدة ويضع القيم المقرؤة (3) يرجع مرة أخري للورقة الحالية جرب التعديل التالي

 


Dim x(99, 99) As Variant


For C = 3 To 8

        For i = 0 To 19

        x(R + i, C) = Cells(i + 6, C)

        Next i


Next C


For C = 3 To 8

        For i = 0 To 19

        Sheet13.Cells(R + i, C) = x(R + i, C)

        Next i

Next C

[قصي]

حتى تتم اللستفاده الكامله

ضع ملفا

والف شكر

[tefa3079]

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