مساعدة فى كشف حساب عميل

[hany1ame]

الرجاء المساعدة فى استخراج كشوف الحسابات للعملاء

العملاء.rar

[hany1ame]

يا شباب وينكم

ما فى أحى يبى يساعد

[الشهابي]

أخي العزيز / hany1ame

أنا اطلعت على ملفك ولكن بصراحة لم أفهم المطلوب بشكل واضح

ففضلا قم بالتوضيح أكثر

فمثلا الأعمدة ( مدين ـ دائن - رقم السند ) وخانتي التاريخ من أين يتم جلب البيانات الخاصة بها

أفضل لو تكتب شرح للمطلوب وسط الخانة الأولية لكل عمود ومن أين يتم جلب البيانات بشكل تفصيلي يكون أفضل

وعلى فكرة ليس لدي أي خبرة في مجال الحسابات

ولكن إذا تم فهم مطلوبك بشكل جيد ممكن مساعدتك إن شاء الله

أو من قبل أحد الإخوان حيث هناك إخوان لهم باع في هذا المجال

والعفو

والله الموفق

[hany1ame]

مشكور يأخى العزيز على اهتمامك وتم ارفاق بعض التوضيحات المطلوبة

و جعل الله هذا بميزان حسناتك

العملاء.rar

[عبدالله باقشير]

السلام عليكم

الشكر واصل للاخ الشهابي

كود:

Option Explicit

'======================================================

'======================================================

'     اسم نطاق رؤوس الاعمدة

'     او عنوان رؤوس الاعمدة ملحوقة باسم الورقة

Private Const MyTopColmnRng As String = "العمليات!$A$3:$G$3"


'  MyTopColmnRng   رقم عمود رقم الحساب من النطاق

Private Const MyColmnFind As Integer = 2


'  MyTopColmnRng   رقم عمود التاريخ من النطاق

Private Const dColmn As Integer = 6

'======================================================

'======================================================

Sub kh_ClearContents()

    Range("B16").Resize(500, 8).ClearContents

End Sub

Sub kh_Start()

Dim MyRng As Range

Dim R As Integer

Dim ContRow As Integer, i As Integer, ii As Integer

Dim tFindNum As String

Dim dt1 As Date, dt2 As Date

'-------------------------

On Error GoTo 1

'-------------------------

Set MyRng = Range(MyTopColmnRng)

'-------------------------

kh_ClearContents

'-------------------------

With MyRng

    ContRow = .Worksheet.Cells(Rows.Count, .Column).End(xlUp).Row - .Row

End With

If ContRow = 0 Then Exit Sub

'-------------------------

'     خلية رقم الحساب المطلوب

tFindNum = LCase(Range("C6"))

'-------------------------

'     خلايا التاريخ

dt1 = DateValue(Range("C12"))

dt2 = DateValue(Range("I12"))

'-------------------------

Application.ScreenUpdating = False

Application.Calculation = xlCalculationManual

'-------------------------

ii = 16

With MyRng.Offset(1, 0)

    For R = 1 To ContRow

        Select Case .Cells(R, dColmn).Value2: Case dt1 To dt2

            If LCase(.Cells(R, MyColmnFind)) Like tFindNum Then


                If Val(.Cells(R, 5)) > 0 Then Cells(ii, "B").Value = Val(.Cells(R, 5))

                If Val(.Cells(R, 5)) < 0 Then Cells(ii, "C").Value = Abs(.Cells(R, 5))

                Cells(ii, "D").Value = Val(Cells(ii - 1, "D")) + Val(.Cells(R, 5))

                Cells(ii, "E").Value = .Cells(R, 4).Value

                Cells(ii, "H").Value = .Cells(R, 1).Value

                Cells(ii, "I").Value = .Cells(R, 6).Value


                ii = ii + 1

            End If

        End Select

    Next

End With

1:

'-------------------------

Application.ScreenUpdating = True

Application.Calculation = xlCalculationAutomatic

'-------------------------

If Err Then

    MsgBox "Err.Number : " & Err.Number

Else

    If ii > 16 Then

        MsgBox "تم الترحيل بنجاح ", vbMsgBoxRight, "الحمدلله"

    Else

        MsgBox "لا توجد نتائج للبحث", vbMsgBoxRight, "عفوا"

    End If

End If

Set MyRng = Nothing

End Sub

المرفق 2003 / 2007

العملاء.rar

[hany1ame]

مشكور أخى العزيز

عمل رائع جد وممتاز

بس ياريت لو توسع نطاق العمليات ليصل الى 10.000 عملية

مع شرح الطريق

شكرا

[عبدالله باقشير]

مشكور أخى العزيز

عمل رائع جد وممتاز

بس ياريت لو توسع نطاق العمليات ليصل الى 10.000 عملية

مع شرح الطريق

شكرا

الكود تلقائي

يعمل الى اخر خلية في اول عمود من النطاق المحدد

في

MyTopColmnRng

' اسم نطاق رؤوس الاعمدة

' او عنوان رؤوس الاعمدة ملحوقة باسم الورقة

Private Const MyTopColmnRng As String = "العمليات!$A$3:$G$3"

اخر خليه في العمود يؤخذ بهذه الاسطر من الكود

With MyRng

    ContRow = .Worksheet.Cells(Rows.Count, .Column).End(xlUp).Row - .Row

End With

فقط غير في كود المسح هنا

Sub kh_ClearContents()

Range("B16").Resize(500, 8).ClearContents

End Sub

ليشمل نطاق اوسع بشكل تقريبي للبيانات اللي ممكن تستدعى وضعنا 10016 بدلا من 500

Sub kh_ClearContents()

Range("B16").Resize(10016, 8).ClearContents

End Sub

[الشهابي]

ما شاء الله أستاذن الكبير / عبد الله باقشير

حقيقة لا يفتى ومالك بالمدينة

زادك الله علماً ورفعة وحفظك الله من كل مكروه

[hany1ame]

الأخ / عبدالله باقشير

مشكوووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووووور

والله يعطيك العافية ولك منى كل التحية والتقدير

[MAHMOUD ALI YOUSSEF]

السلام عليكم

استاذنا القدير خبور خير

اكوادك دائما اكثر من رائعة ونستفاد ايضا منها

جزاك الله كل خير :fff:

[أبو أنس حاجب]

السلام عليكم ورحمة الله وبركاته

أستاذي وسيدي الفاضل عبد الله باقشير حفظك الله

لم يعمل الكود بشكل صحيح الا بعد ان غيرت السطر الذي يحدد عدد الأسطر بهذا

For R = 1 To 32000

علماً انه لم يقبل مني رقم اكبر من هذا السطر في حالة اضفت رقم اكبر لعدد الصفوف يعطيني خطأ كالتالي Err.Number:6 والمطلوب لدي حتى السطر 60000

تعريف المتغير ConRow لا يعمل معي أن أمكن تغييره بمتغير رقمي حتى السطر 60000

مع جزيل الشكر والتقدير والاحترام جزاك الله كل خير

أبو أنس

[عبدالله باقشير]

السلام عليكم

اخي الفاضل / الشهابي -------------حفظه الله

اخي الفاضل / محمود -------------حفظه الله

جزاكما الله خيرا وبارك فيكما

اخي الفاضل / ابو انس-------------حفظه الله

غير المتغيرات

من

Integer

الى

Long

حيعمل معاك لكن حتقل سرعة التنفيذ قليلا

جرب

تقبلوا تحياتي وشكري