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

[saad abed]

الاخوة الافاضل

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

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

وانا اريدها كذلك ولكن بطريقة اجمالية

رقم الفاتورة واحد ولو تعددت الاصناف وكذلك باقى البيانات ثم اجمالى قيمة الاصناف

لا اريد تفاصيل الاصناف

اشكركم

Book1.rar

[جمال عبد السميع]

أسف أستاذي العزيز ( سعد ) هذا تصور علي قدي

كشف حساب.rar

[أبو حنــــين]

هذه محاولة مني بعد إذن اخي الحبيب الأستاذ محمود

فاتورة.rar

[saad abed]

اخى العزيز محمود

فخر لى ان تهتم بموضوع لى

اشكرك كل الشكر تعلمت من ملف اشياء جميله

ولكن

لكى تصل الى ما اريد بسهوله

اختار اسمى فى ملفك سيظهر ثلاث صفوف اريدهم صف واحد لانهم فاتورة واحدة ولكن عند العمود g يكون مجموع الفاتورة 135

انا سميته كشف حساب اجمالى علشان لا يهتم بتفاصيل الفاتورة وانما رقمها اسم المورد تاريخ الفاتورة مجموع قيم الاصناف

ارجو ارن اكون وفقت فى شرح ما اريد

[saad abed]

اخى ابوحنين

اشكرك كل الشكر على تجاوبك وتواصلك معى

انظر المرفق

لعلى اصل للمطلوب

ما فعلته هو المطلوب ولكن بشرط عدم تكرار البيانات

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

المرفق يوضح لك المطلوب

اشكرك

فاتورة.rar

[الـعيدروس]

السلام عليكم

اخي سعد عابد حسب فهمي لطلبك

جرب هذا الكود

Dim Sh As Worksheet

Public Sub Ali_T()

Dim S As Worksheet

Dim Rn As Range

Dim R

Set S = Sheets("مشتريات")

Set Sh = Sheets("RR")

Rw = 6

L_r = S.Cells(Rows.Count, 2).End(xlUp).Row

Set Rn = S.Range(S.Cells(5, 1), S.Cells(L_r, 10))

With Application

   .ScreenUpdating = False

   .EnableEvents = False

With Rn

  For R = 1 To .Rows.Count

   If .Cells(R, 1).Value >= S.[J1] And .Cells(R, 1).Value <= S.[K1] Then

    If .Cells(R, 6) = S.[F2] Then

    S.Range(.Cells(R, 2), .Cells(R, 9)).Copy

    Sh.Cells(Rw, 2).PasteSpecial xlPasteValues

    Rw = Rw + 1

    End If

   End If

  Next

End With

   .CutCopyMode = False

   .EnableEvents = True

   .ScreenUpdating = True

End With

If WorksheetFunction.CountA(Sh.Range("B6:B10")) >= 2 Then Ali_Ds

End Sub

Private Sub Ali_Ds()

Dim Rn, L_Rn As Range

Dim A_di As Object

Dim A_Sum(), V_Rn()

Dim A_i As Long, E, Dc, L_r, L_rr As Long

Set Sh = Sheets("RR")

With Application

   .ScreenUpdating = False

   .EnableEvents = False

	 Sh.Activate

    .ScreenUpdating = False

    L_r = Sh.Cells(.Rows.Count, "B").End(xlUp).Row + 1

    Set Rn = Sh.Range("B6:I" & L_r)

    Rn.Select

    V_Rn = Rn.Value

    ReDim A_Sum(1 To UBound(V_Rn, 1), 1 To 8)

    Set A_di = CreateObject("Scripting.Dictionary")

    With A_di

	    For A_i = 1 To UBound(V_Rn, 1)

		  If Not .exists(V_Rn(A_i, 1)) Then

			 E = E + 1

			  For Dc = 1 To 8

			    A_Sum(E, Dc) = V_Rn(A_i, Dc)

			  Next Dc

			 .Add V_Rn(A_i, 1), E

		    ElseIf .exists(V_Rn(A_i, 1)) Then

			    A_Sum(.Item(V_Rn(A_i, 1)), 7) = A_Sum(.Item(V_Rn(A_i, 1)), 7) + V_Rn(A_i, 7)

		    End If

	    Next A_i

    End With

    L_rr = ActiveSheet.UsedRange.Rows.Count

    Set L_Rn = Range("B6:I" & L_rr)

    L_Rn.Clear

    Sh.Range("B6").Resize(E, 8).Value = A_Sum

    .EnableEvents = True

    .ScreenUpdating = True

End With

End Sub

فاتورة_A.rar

تم تعديل ديسمبر 15, 2012 بواسطه عباد

[أحمد السيد]

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

بصراحه عمل فوق الرائع

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

بصراحه يا جماعه انا عاوز اتعلم الماكرو والفيجول والاكواد لانى محتاج اعمل برنامج ومش عارف ضفت قبل كده نموذج لبرنامج بسيط جدا محتاجه والله فى شغلى ومش عارف اعمل ايه بس المشكله ان مكنتش اعرف سياسة المنتدى فموضوعى اغلق

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

ان حد يساعدنى انى اتعلم الماكرو والاكواد عشان اولا محتاج اتعلمه لنفسى وثانيا محتاج اعمل برنامج بسيط لاوامر الشراء

فارجو من الجميع ان يساعدنى

تقبلوا مرورى

تم تعديل ديسمبر 15, 2012 بواسطه Ahmed Dawam

[احمد عبد الناصر]

هذا حل اخر باستخدام المعادلات

تحياتي

Book1+.rar

[جمال عبد السميع]

بعد إذن إخوتي أتمني أن يكون المرفق التالي محققا المطلوب

كشف حساب إجمالي.rar

تم تعديل ديسمبر 15, 2012 بواسطه mahmoud-lee

[saad abed]

اخى عباد ابونصار

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

ما توقعت للوصول لهذه النتيجة ابدا

اعماللك واكوادك ما شاء الله مبهره

هناك ملحوظتين يا ريت تحاول معى حتى اصل لما اريد

كل الشكر والتقدير

اولا اريد نقل التاريخين واسم المورد ( متغيرات البحث ) الى صفحة rr صفحة التى ننقل البيانات

ثانيا عمود الاصناف لا اريده مجموع الفاتورة اريده فى العمود g ولا اريد ما بعده

بمعنى البيان اسماء الاصناف لا اريد ظهوره وبدلا منها مجموع الفاتورة

[الـعيدروس]

السلام عليكم

الاخ الحبيب سعد عابد الخلوق جدا

اشكرك جد على كلماتك المشجعه وشعورك الطيب

السموحه على التأخير

إطلع على المرفق امل أن يكون المطلوب

وأي إضافات أو تعديل أنا في الخدمه

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

فاتورة_Sad_Aabd.rar

[saad abed]

_{اخى عباد ابونصار}

_{كل الشكر لك وعلى ردودك التى ابهرتنى}

_{ولكى لا اتعبك معى داخل المرفق حاولت شرح الكود لنفسى فى محرر الاكواد ولكن هناك افكار داخل الكود تخفى على ان استطعت شرح مبسط داخل المحرر اكون شاكر لك}

_{لانى ساطبقه على صفحات اخرى واريد ان يكون التاريخ دخوله فى خلية وليس كمبوبكس (يدوى افضل)}

_{اعتذر لك على كثرة طلباتى}

_{اخوك سعد}

فاتورة_Sad_Aabd.rar

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

السلام عليكم

اثراءا للموضوع

مع الشكر لاخي عباد

بمثل هذا الكود اطلع ميزان مراجعة

لاكثر من 15000 سجل

Option Explicit


'  عدد الاعمدة في الكشف

Const ContColmn As Integer = 6

'  عمود الاسم من  نطاق البيانات

Const iName As Integer = 5

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

Const idate As Integer = 4

'  عمود المجموع من  نطاق البيانات

Const iSm As Integer = 9

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

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


Sub kh_Report()

Dim Co As New Collection

Dim x()

Dim v As Double

Dim iTm As Range, Rng As Range

Dim i As Long, LastRow As Long, iCont As Long

Dim c As Integer

'''''''''''''''''''''

LastRow = Cells(Rows.Count, "B").End(xlUp).Row

Range("B6").Resize(LastRow, ContColmn).ClearContents

'''''''''''''''''''''

With Sheets("مشتريات")

    LastRow = .Cells(Rows.Count, "B").End(xlUp).Row

    Set Rng = .Range("B5:B" & LastRow)

End With

'''''''''''''''''''''

ReDim x(1 To ContColmn)

'''''''''''''''''''''

On Error GoTo kh_ex

'''''''''''''''''''''

For Each iTm In Rng

    If kh_Tst(iTm.Cells(1, iName), iTm.Cells(1, idate)) Then

        v = 0

1:      On Error Resume Next

        For c = 1 To 5

            x(c) = iTm.Cells(1, c)

        Next

        x(6) = Val(iTm.Cells(1, iSm)) + v

        '''''''''''''''''''

        Co.Add x, CStr(iTm)

        '''''''''''''''''''

        If Err Then

            v = Val(Co(CStr(iTm))(6))

            Co.Remove CStr(iTm)

            Err.Clear

            GoTo 1

        End If

        '''''''''''''''''''

    End If

Next

'''''''''''''''''''''''''

iCont = Co.Count

If iCont Then

    For i = 1 To iCont

        With Range("B6")

            .Cells(i, 1).Resize(1, ContColmn).Value = Co.Item(i)

        End With

    Next

End If

'''''''''''''''''''''''''

With Range("B6").Resize(iCont, ContColmn)

    .Sort .Columns(1), xlAscending

End With

'''''''''''''''''''''''''


kh_ex:

''''''''''''''''''

Set Co = Nothing

Set Rng = Nothing

Erase x

End Sub


Function kh_Tst(N As String, dd) As Boolean

Dim ib As Boolean

If N = Trim(Range("E2").Value) Then

    Select Case dd

        Case Range("E3").Value2 To Range("E4").Value2

        ib = True

    End Select

End If

kh_Tst = ib

End Function

المرفق 2003

كشف حساب اجمالي سعد.rar

[جمال عبد السميع]

ماشاء الله عالمي الجليل ( عبدالله بقشير ) أعمال حضرتك مرجع لكل من أراد الرقي في عملة وتعليمة بارك الله فيك وأدامك الله لنا معلما وأستاذا

[saad abed]

اخى عبدالله باقشير

بسم الله ماشاء الله لا قوة الا بالله

كعادة اعمالك كلها متقنة سريعة فريدة

الله الله الله

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

بارك الله فيك

سعد عابد

[الـعيدروس]

السلام عليكم

الاستاذ الكبير عبدالله باقشير

صدقني كنا بإنتظار مشاركتك

لان أعمالك فريده من نوعها

واكواد متقنه مختصره تنم عن خبره

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

[أبو ردينة]

ماشاء الله لا قوة إلا بالله

بارك الله في جميع الإخوة الحباب على هذة الجهود الطيبة و الحلول المميزة

سؤال لأخي الكريم أ / عبد الله با قشير

لاحظت في الكود إستخدام

Dim x()


ReDim x(1 To ContColmn)

آمل التكرم مشكورا بشرح الحالات التي يمكن فيها إستخدام (ReDim) لما سبق الإعلان عنه أو تعريفه ب (Dim)

جزاكم الله خيرا

تم تعديل ديسمبر 17, 2012 بواسطه أبو ردينة

[الـعيدروس]

الاخ ابو ردينه

هذا متغير مصفوفة لمدى البيانات

من العمود 1 الى اخر عمود المحدد في بداية الكود ContColmn = 6

ReDim x(1 To ContColmn)