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 ولم ينفع الامر