black-eagle

السلام عليكم و رحمة الله و بركاته لدي عدة ملفات اكسيل لا استطيع فتحها بسبب تخطي الاسطر المسموح بها كل ملف يحوي على 6 اعمدة و اكثر من المليون سطر و ملف ال VBA لدي يتطلب قرائة كافة الاسطر و الا اعطا نتائج خاطئة فكيف استطيع تشغيل الملف دون فقدان للبيانات ؟؟ هل استطيع مثلا ان اقوم بتجزئة الملف الى ملفين اثنين و تشغيل ال VBA دون فقدان للقيم الموجودة فيه ؟ ما الطريقة الى ذلك بارك الله بمن يجيب

UP

UP FIN.rar

اخواني الكرم , شكرا لكم على المساعدة الطيبة حاولت تعديل تعديل الكود ليصبح لدي ستيب متعدد اريد وضع الستيب على الشكل Y1 = E2 , CLM1 = 5 Y2 = F2 , CLM2 =6 Y3 = G2 , CLM3=7 . . علما ان Y هي قيمة الستيب و CLm هي رقم العمود همسة : المف يأخذ وقتا في قراءة البيانات, ان امكن جعل القيم تكتب معا في كامل الاعمدة لا ان يعيد القراءة في كل عامود ,, و شكرا

بارك الله بك استاذنا الغالي عند وضع x+1 يعطيني mismatch error لكن مع x+5 يعمل على نفس السرعة السابقة

ممكن الكود بعد التعديل ؟

شكرا لك اخي الكريم و لكن الطريقة لم تساعد بتسريع الملف اظن المشكلة مع الكود

ارجو التوضيح اكثر ان تكرمت

شكرا لك اخي ياسر على المداخلة الكريمة ,, مسألة البطء بسبب ضخامة قاعدة البيانات اي مايقارب 50000 سطر و لأكثر من ملف تأخذ العملية ما يقارب ال 30ثانية لتنتهي , علما و عند الاستخدام تكون الرامات الفارغة 2GB و المعالج لا يستهلك اكتر من 10% ربما المسألة لها علاقة بمعادلات الكود او التكرار و ما الا ذالك

هل من طريقة محددة اخواني الكرام ؟

شكرا لك اخي الكريم FIN.rar

بارك الله بك استاذ حسام ,, بصراحة خبرتي البرمجية ضئيلة و هذا تم بمساعدة كريمة من استاذنا الكبير احمد عبد الناصر جزاه الله كل خير

تفضل الكود مشكورا Dim y1, y2, z, g, L, H Sub dd() Rw = 5 Y = Val(InputBox("step")) clm = Val(InputBox("Column")) x = Cells(Cells.Rows.Count, clm).End(xlUp).Row If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear End If endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row g = [B5] y1 = g - Y y2 = g + Y L = g H = g For r1 = 5 To endr d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2)) d1 = Format(d, "dddd") d2 = Cells(r1, 1) d = Cells(r1, 1) If Cells(r1, 2) < L Then L = Cells(r1, 2) If Cells(r1, 2) > H Then H = Cells(r1, 2) 1: If check(Cells(r1, 2)) = 1 Then Cells(r2 + 5, clm) = "down" & String(z1, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & "" If H <> 0 Then hh = H H = 0 r2 = r2 + 1 g = g - Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) <= y1 Then z1 = 1 GoTo 1 End If ElseIf check(Cells(r1, 2)) = 2 Then Cells(r2 + 5, clm) = "up" & String(z2, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & "" If L <> 999999 Then ll = L L = 999999 r2 = r2 + 1 g = g + Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) >= y2 Then z2 = 1 GoTo 1 End If End If Next End Sub Function check(x) If x <= y1 Then check = 1 ElseIf x >= y2 Then check = 2 ElseIf x > y1 And x < y2 Then check = 3 End If End Function

السلام عليكم اخواني الكرام ,, لدي قاعدة بيانات كبيرة و ملف الاكسيل يعمل بشكل بطيئ هل من طريقة لتسريعه ؟؟ حاولت تغير الاحقة الى xlsb ولم ينفع الامر

up

السلام عليكم لدي ملف من برمجة الاستاذ الكريم احمد عبد ناصر يأخذ الخلية الأولى التي تحوي رقما [b5] ثم يضف اليها الستيب المطلوب ليكتب بعدها Up , Down وفق تسلسل الارقام احتاج فيه الى كود لطرح ال Highest من السلسلة G داخل الكومنت .. كما في الملف التالي تقبلو تحياتي FIN.rar

ملاحظ حسب ماتوصلتو اليه ان الخلية التي بها Highest تعتبر ليس لها قيمة الـ Lowest والعكس برضه فكيف بيكون الطرح ؟ نعم الاستاذ الكريم أحمد أفادني خير افادة .. بارك الله به بالنسبة لسؤالك .. فالقيمة Highest هي اعلى رقم بين قيمتين من السلسة G ( أي قبل الوصول الى احد قيم G التالية ) و ال Lowest أصغر رقم بين قيمتين من G ما اريده هو طرح ال Highest من G و طرح G من Lowest و هذا الكود كاملا دون أخطاء Dim y1, y2, z, g, L, H Sub dd() Rw = 5 Y = Val(InputBox("ÈÑÌÇÁ ÇÏÎá ÞíãÉ step")) clm = Val(InputBox("ÈÑÇÌÇÁ ÇÏÎÇá ÑÞã ÚãæÏ ÇáäÊíÌÉ")) x = Cells(Cells.Rows.Count, clm).End(xlUp).Row If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear End If endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row g = [B5] y1 = g - Y y2 = g + Y L = g H = g For r1 = 5 To endr d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2)) d1 = Format(d, "dddd") d2 = Cells(r1, 1) d = Cells(r1, 1) If Cells(r1, 2) < L Then L = Cells(r1, 2) If Cells(r1, 2) > H Then H = Cells(r1, 2) 1: If check(Cells(r1, 2)) = 1 Then Cells(r2 + 5, clm) = "down" & String(z1, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & "" If H <> 0 Then hh = H H = 0 r2 = r2 + 1 g = g - Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) <= y1 Then z1 = 1 GoTo 1 End If ElseIf check(Cells(r1, 2)) = 2 Then Cells(r2 + 5, clm) = "up" & String(z2, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & "" If L <> 999999 Then ll = L L = 999999 r2 = r2 + 1 g = g + Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) >= y2 Then z2 = 1 GoTo 1 End If End If Next End Sub Function check(x) If x <= y1 Then check = 1 ElseIf x >= y2 Then check = 2 ElseIf x > y1 And x < y2 Then check = 3 End If End Function

up

UP

السلام عيكم اخواني هذا كود من ترتيب الاستاذ ناصر .. أرجو من أحد الاخوة مساعدتي في ايجاد ناتج طرح L , H من قيم G ( السلسلة التي على اساسها يتحدد ال Up , Down ) Dim y1, y2, z, g, L, H Sub dd() Rw = 5 Y = Val(InputBox("ÈÑÌÇÁ ÇÏÎá ÞíãÉ step")) clm = Val(InputBox("ÈÑÇÌÇÁ ÇÏÎÇá ÑÞã ÚãæÏ ÇáäÊíÌÉ")) x = Cells(Cells.Rows.Count, clm).End(xlUp).Row If Cells(Cells.Rows.Count, clm).End(xlUp).Row >= 5 Then Range(Cells(5, clm), Cells(Cells(Cells.Rows.Count, clm).End(xlUp).Row, clm)).Clear End If endr = Cells(Cells.Rows.Count, 1).End(xlUp).Row g = [B5] y1 = g - Y y2 = g + Y L = g H = g For r1 = 5 To endr d = DateSerial(Mid(Cells(r1, 1), 1, 4), Mid(Cells(r1, 1), 6, 2), Mid(Cells(r1, 1), 9, 2)) d1 = Format(d, "dddd") d2 = Cells(r1, 1) d = Cells(r1, 1) If Cells(r1, 2) < L Then L = Cells(r1, 2) //////// هنا If Cells(r1, 2) > H Then H = Cells(r1, 2) //////// هنا 1: If check(Cells(r1, 2)) = 1 Then Cells(r2 + 5, clm) = "down" & String(z1, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom = IIf(IIf(H <> 0, H, hh) < g, "no", IIf(Round((IIf(H <> 0, H, hh) - 100) / Y) = (IIf(H <> 0, H, hh) - 100) / Y, "no", IIf(H <> 0, H, hh))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Highest : " & fom & " " & Chr(10) & "" If H <> 0 Then hh = H ////////// هنا H = 0 r2 = r2 + 1 g = g - Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) <= y1 Then z1 = 1 GoTo 1 End If ElseIf check(Cells(r1, 2)) = 2 Then Cells(r2 + 5, clm) = "up" & String(z2, "+") Cells(r2 + 5, clm).AddComment Cells(r2 + 5, clm).Comment.Visible = False fom2 = IIf(IIf(L <> 999999, L, ll) > g, "no", IIf(Round((IIf(L <> 999999, L, ll) - 100) / Y) = (IIf(L <> 999999, L, ll) - 100) / Y, "no", IIf(L <> 999999, L, ll))) Cells(r2 + 5, clm).Comment.Text Text:="Author:" & Chr(10) & "Date : " & d1 & " " & Chr(10) & " " & d2 & "" & Chr(10) & "Lowest : " & fom2 & " " & Chr(10) & "" If L <> 999999 Then ll = L /////////// هنا L = 999999 r2 = r2 + 1 g = g + Y y1 = g - Y y2 = g + Y z1 = 0 z2 = 0 If Cells(r1, 2) >= y2 Then z2 = 1 GoTo 1 End If End If Next End Sub Function check(x) If x <= y1 Then check = 1 ElseIf x >= y2 Then check = 2 ElseIf x > y1 And x < y2 Then check = 3 End If End Function اريد طرح H و L من القيم G لتظهر لدي قيم ال Highest و Lowest في خانة الكومنت

Up

السلام عليكم اخواني الاعزاء .. اعلم أن أخي الأستاذ ناصر مشغول جدا فان تكرم أحدكم و علمني كيف أطرح ال Highest و ال Lowest من القيمة G في خانة الكومنت مع الشكر

أخي الكريم .. لو تكرمت هل يمكن ان تعطيني كود طرح ال Highest , Lowest من القيمة G حاولت و لم انجح :(

و عليكم السلام الملف على أفضل مما يكون .. عمل متعوب عليه بارك الله بك يعمل دون أخطاء الا ان وضعنا الفاصلة بين الارقام ,, يصبح في عالم أخر أرجو إن تسنا لك الوقت أن تنظر في هذا الملف مشكورا sttp +FIN 1.rar