اذهب الي المحتوي
أوفيسنا

مساعدة غى فورم كشف حساب متعددة( اعمار الديون )

mody200

بواسطه mody200
في منتدى الاكسيل Excel

 مشاركة
إذهب إلى أفضل إجابة Solved by محمد هشام.,

الردود الموصى بها

mody200

mody200

قام بنشر
قام بنشر (معدل)

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

معكم محمود حسين من اسوان

انا جديد فى المنتدى وخبرتى فى مجال VBA قصيرة

الرجاء مساعدتى مع الاستفادة من خبراتكم فى هذا العمل

 الرجاء مساعدتى فى اختيار بيانات بين تاريخين واختيار نوع الحدث سواء نوع المستند او اسم الصنف او اسم العميل او كل البيانات

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

هو عبارة عن فورم كشف حساب

وشكرا جزيلا للقائمين على هذا الصرح الرائع

كشف حساب عميل.xlsm

تم تعديل بواسطه mody200
رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر

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

الف شكر لك السيد الكريم /محمد هشام

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

 (TextBox4)اولا المقصود نقس فكرة كرت الصنف او رصيد الخزينة الذى يجلب القيمة فى اول المدة

 (TextBox1)وكذلك  رصيد بعد نهاية المده

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

مع مراعات لو كانت يوجد مديونية قبل هذا التاريخ الذى تم تحديه فى خانتى التاريخ( Combobox10/Combobox2)

كمثال نهاية المدة فى تاريخ19/11/2023 (74800.95)

 (TextBox4) القيمة فى اول المدة يتم اظهارها فى 

فى خالة اذا تم عملية البحث بعد هذا التاريخ 20/11/2024 حتى 30//11/2024

 (TextBox1)ويظهر رصيد نهاية المدة فى 

(58009.31)

وارجو ان اكون وفقت فى ايضاح طلبى

وارجو ان يكون عملية البحث كفلتر للبيانات

وشكر

رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر (معدل)

 

في 11‏/7‏/2024 at 19:43, mody200 said:

 الرجاء مساعدتى فى اختيار بيانات بين تاريخين واختيار نوع الحدث سواء نوع المستند او اسم الصنف او اسم العميل او كل البيانات

لقد تم الاشتغال على 95 في المئة من المطلوب يتبقى لك تعديل الاكواد بما يناسيك للحصول على نتائج عناصر  Textbox او ارفاق عينة للنتائج المتوقعة يدويا ربما نستطيع مساعدتك  

Option Compare Text
Dim f, NomTableau, TabBD(), ColCombo(), colVisu()
Dim colInterro(), Irow, NcolInt, Choix()
Private Sub UserForm_initialize()
 Set f = Sheet1
 Set Rng = f.Range("A3:L" & f.[a65000].End(xlUp).Row)
 NomTableau = "Tableau1"
 Irow = Range(NomTableau).Columns.Count
 TabBD = Range(NomTableau).Resize(, Irow + 1).Value
 For I = 1 To UBound(TabBD): TabBD(I, Irow + 1) = I: Next I
 ColCombo = Array(3, 4, 5)
 colVisu = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
 colInterro = colVisu
 Me.ListBox1.ColumnWidths = "55;80;80;60;60;100;55;55;45;55"
 NcolInt = UBound(colInterro) + 1
 Me.ListBox1.List = TabBD
 For I = UBound(ColCombo) + 1 To 2
   Me("combobox" & I + 1).Visible = False: Me("Cnt" & I + 1).Visible = False
 Next I
 For c = 1 To UBound(ColCombo) + 1: Me("combobox" & c) = "*": Next c
 For c = 1 To UBound(ColCombo) + 1: ListeCol c: Next c
 For I = 1 To UBound(ColCombo) + 1:  Me("Cnt" & I) = Range(NomTableau).Offset(-1).Item(1, ColCombo(I - 1)): Next I
 Me.ListBox1.ColumnCount = Irow + 1
 colDate = 2
 Set d = CreateObject("scripting.dictionary")
 For I = LBound(TabBD) To UBound(TabBD)
    d(TabBD(I, colDate)) = ""
 Next I
 Dates = d.keys
 Me.DateMini.List = Dates: Me.DateMini = Dates(0)
 Me.DateMaxi.List = Dates: Me.DateMaxi = Dates(UBound(Dates))
 Me.Frame1.ScrollWidth = Me.ListBox1.Width + 10
 Me.Frame1.ScrollBars = 1
  For I = 1 To 12: Me("label" & I) = f.Cells(3, I): Next I
 Me.ComboTri.List = Application.Transpose(Range(NomTableau).Offset(-1).Resize(1))
 Filtre
 B_ajout_Click
 
' Me.DateMini.Value = FormatDateTime(WorksheetFunction.EDate(Date, -1))
' Me.DateMaxi.Value = FormatDateTime(Date, vbShortDate)
End Sub

  

Sub Filtre()
If Me.DateMini = "" Or Me.DateMaxi = "" Then Exit Sub
For I = 1 To 3
Me.Controls("TextBox" & I).Value = ""
Next I
S.Caption = ""
  Dim Tbl()
  cbx1 = Me.ComboBox1: cbx2 = Me.ComboBox2:  cbx3 = Me.ComboBox3
  n = 0
  dMini = CDate(Me.DateMini): dMaxi = CDate(Me.DateMaxi)
  Cb = Array(1, 1, 1)
  For I = 0 To UBound(ColCombo): Cb(I) = ColCombo(I): Next I
  For I = 1 To UBound(TabBD)
    If TabBD(I, Cb(0)) Like cbx1 And TabBD(I, Cb(1)) Like cbx2 _
       And TabBD(I, Cb(2)) Like cbx3 _
         And TabBD(I, 2) >= dMini And TabBD(I, 2) <= dMaxi Then
        n = n + 1: ReDim Preserve Tbl(1 To Irow + 1, 1 To n)
        c = 0
        For c = 1 To Irow: Tbl(c, n) = TabBD(I, c): Next c
        Tbl(c, n) = TabBD(I, Irow + 1)
    End If
  Next I
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     SUMIF
  Else
     Me.ListBox1.Clear
  End If
End Sub
   '********************************
Sub SUMIF()
Dim sum As Double
Dim Cnt As Long
 Cnt = 0: sum1 = 0: sum2 = 0
On Error Resume Next
        With ListBox1
            For R = 0 To .ListCount - 1
             Cnt = Cnt + 1
                sum1 = sum1 + .List(R, 10)
                sum2 = sum2 + .List(R, 11)
            Next R
        End With
Me.S.Caption = Cnt
TextBox3.Value = sum1: TextBox2.Value = sum2: TextBox1.Value = sum1 - sum2
TextBox1.Value = Format(Val(Replace(TextBox1.Value, ",", ".")), "#,##00.00")
TextBox2.Value = Format(Val(Replace(TextBox2.Value, ",", ".")), "#,##00.00")
TextBox3.Value = Format(Val(Replace(TextBox3.Value, ",", ".")), "#,##00.00")
End Sub

 

Capturedcran2024-07-18215801.png.9944bee3a9bf25394e464f6c7eea5b09.png

 

 

 

Copy of كشف حساب عميل.xlsm

تم تعديل بواسطه محمد هشام.
رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر (معدل)

الف شكر على المجهود الرائع السيد محمد هشام

يالنسبة لرصيد الختمامى قبل تاريخ البداية وهو ( رصيد اول المدة )

لوافترضنا اننا نريد اظهار المديونية للعميل من يوم 19/11/2023 حتى 30/01/2024

نريد اظهار الرصيد الختامى قبلتاريخ 19/11/2023

وجد كود 

وارجو تعديله نظرا لخبرتى فى مجال الvba لاتكفى 

Sub The_balance_of_the_first_duration5()
Dim x As String, z As String
Dim ws As Worksheet
Set ws = Sheets("كشف حساب")
x = WorksheetFunction.SumIfs(ws.Range("g:g"), ws.Range("c:c"), ("قيد"), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)))
xx = WorksheetFunction.SumIfs(ws.Range("g:g"), ws.Range("c:c"), ("مبيعات"), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)))
z = WorksheetFunction.SumIfs(ws.Range("h:h"), ws.Range("c:c"), ("مردودات مبيعات"), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)))
zz = WorksheetFunction.SumIfs(ws.Range("h:h"), ws.Range("c:c"), ("سند قيد"), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)))
zzz = WorksheetFunction.SumIfs(ws.Range("h:h"), ws.Range("c:c"), ("سند قبض"), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)), ws.Range("b:b"), "<" & CLng(CDate(DateMini.Value)))
 Me.Text_count.Value = Evaluate(x) + Evaluate(xx) - Evaluate(z) + Evaluate(zz) + Evaluate(zzz)
End Sub

'  (Call The_balance_of_the_first_duration5)ملحوظة وضعت الكود فى الفلتر

Sub Filtre()
If Me.DateMini = "" Or Me.DateMaxi = "" Then Exit Sub
For I = 1 To 3
Me.Controls("TextBox" & I).Value = ""
Next I
S.Caption = ""
  Dim Tbl()
  cbx1 = Me.ComboBox1: cbx2 = Me.ComboBox2:  cbx3 = Me.ComboBox3
  n = 0
  dMini = CDate(Me.DateMini): dMaxi = CDate(Me.DateMaxi)
  Cb = Array(1, 1, 1)
  For I = 0 To UBound(ColCombo): Cb(I) = ColCombo(I): Next I
  For I = 1 To UBound(TabBD)
    If TabBD(I, Cb(0)) Like cbx1 And TabBD(I, Cb(1)) Like cbx2 _
       And TabBD(I, Cb(2)) Like cbx3 _
         And TabBD(I, 2) >= dMini And TabBD(I, 2) <= dMaxi Then
        n = n + 1: ReDim Preserve Tbl(1 To Irow + 1, 1 To n)
        c = 0
        For c = 1 To Irow: Tbl(c, n) = TabBD(I, c): Next c
        Tbl(c, n) = TabBD(I, Irow + 1)
    End If
  Next I
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     SUMIF
  Else
     Me.ListBox1.Clear
  End If
Call The_balance_of_the_first_duration5
End Sub

 

 

Copy of كشف حساب عميل (1).xlsm

تم تعديل بواسطه mody200
رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر (معدل)

جرب هدا  

Sub SUMIF()
Dim WS As Worksheet: Set WS = Sheets("كشف حساب")
Dim sum As Double, Cnt As Long
 WS.[Y1] = CDate(Me.DateMini)
 Cnt = 0: sum1 = 0: sum2 = 0
On Error Resume Next
        With ListBox1
            For R = 0 To .ListCount - 1
             Cnt = Cnt + 1
                sum1 = sum1 + .List(R, 10)
                sum2 = sum2 + .List(R, 11)
            Next R
        End With
Me.S.Caption = Cnt
TextBox3.Value = Format(sum1, "#,##00.00"): TextBox2.Value = Format(sum2, "#,##00.00")
tb = sum1 - sum2
TextBox1.Value = Format(tb, "#,##00.00")

tb1 = Evaluate("=SUM(SUMIFS('" & WS.Name & "'!G4:G100000,'" & WS.Name & _
     "'!C4:C100000,{""مبيعات"";""قيد""},'" & WS.Name & "'!B4:B100000,""<=""&'" & WS.Name & "'!Y1))")

tb2 = Evaluate("=SUM(SUMIFS('" & WS.Name & "'!H4:H100000,'" & WS.Name & _
"'!C4:C100000,{""مردودات مبيعات"";""سند قيد"";""سند قبض""},'" & WS.Name & "'!B4:B100000,""<=""&'" & WS.Name & "'!Y1))")

result = tb1 - tb2
Me.Text_count.Value = Format(result, "#,##00.00")
End Sub

 

 

Copy of كشف حساب عميل V2.xlsm

تم تعديل بواسطه محمد هشام.
  • Like 2
رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر

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

لوافترضنا ان تم اختيار التاريخ من 16/11/2023 حتى20/11/2023

فان الرصيد الختامى ليوم 16/11/2023 يكون74669.26

ولاكن اريد ان يكون الرصيد الختامى ليس فى نفس اليوم ولاكن يكون فى نهاية اليوم الذى قبله وهو 77054.46

كما هو موضح فى الصورة

اما بخصوص التاريخ اريد ان يكون صيغتة كما هو موضح dd/mm/yyyy

thumbnail123.jpg

رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر (معدل)

جرب هل هدا ما تقصده 

22.png.47f511772ee96667bec5400702eec372.png 

tb1 = Evaluate("=SUM(SUMIFS('" & WS.Name & "'!G4:G100000,'" & WS.Name & _
     "'!C4:C100000,{""مبيعات"";""قيد""},'" & WS.Name & "'!B4:B100000,""<""&'" & WS.Name & "'!Y1))")
tb2 = Evaluate("=SUM(SUMIFS('" & WS.Name & "'!H4:H100000,'" & WS.Name & _
"'!C4:C100000,{""مردودات مبيعات"";""سند قيد"";""سند قبض""},'" & WS.Name & "'!B4:B100000,""<""&'" & WS.Name & "'!Y1))")

result = tb1 - tb2
    Me.Text_count.Value = Format(result, "#,##00.00")
    If Me.Text_count = 0 Then colDates

 

18 ساعات مضت, mody200 said:

اريد ان يكون صيغتة كما هو موضح dd/mm/yyyy

 كما ترى في الصورة التواريخ تظهر معي بالشكل المطلوب قم بتعديل  تنسيق التاريخ  على الجهاز الخاص بك الى  dd/mm/yyyy

2.png.6e9bcbe03c87000fbe145a9716f2e221.png

او تعديل الكود  

Sub Filtre()
If Me.DateMini = "" Or Me.DateMaxi = "" Then Exit Sub
For i = 1 To 3
Me.Controls("TextBox" & i).Value = ""
Next i
S.Caption = ""

  Dim Tbl()
  cbx1 = Me.ComboBox1: cbx2 = Me.ComboBox2:  cbx3 = Me.ComboBox3
  n = 0
  dMini = CDate(Me.DateMini): dMaxi = CDate(Me.DateMaxi)
  Cb = Array(1, 1, 1)
  For i = 0 To UBound(ColCombo): Cb(i) = ColCombo(i): Next i
  For i = 1 To UBound(TabBD)
    If TabBD(i, Cb(0)) Like cbx1 And TabBD(i, Cb(1)) Like cbx2 _
       And TabBD(i, Cb(2)) Like cbx3 _
         And TabBD(i, 2) >= dMini And TabBD(i, 2) <= dMaxi Then
        n = n + 1: ReDim Preserve Tbl(1 To Irow + 1, 1 To n)
        c = 0
        For c = 1 To Irow: Tbl(c, n) = TabBD(i, c): Next c
        Tbl(c, n) = TabBD(i, Irow + 1)
          Tbl(2, n) = Format(TabBD(i, 2), "dd/mm/yyyy") ' تنسيق عمود التاريخ
    End If
  Next i
  If n > 0 Then
     Me.ListBox1.Column = Tbl
     SUMIF
  Else
     Me.ListBox1.Clear
  End If
End Sub

 

 

Copy of كشف حساب عميل -V3.xlsm

تم تعديل بواسطه محمد هشام.
  • Like 2
رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر (معدل)

السيد محمد هشام اشكرك على هذا المجهود الرائع انه يعمل

شكر جزيلا لك 

ولاكن عند عملية البحث بين تاريخين فأن TextBox1,TextBox2,TextBox3 لايظهر قيم الليست بوكس من المبيعات والتخصيلات ورصيد ختامى

تم تعديل بواسطه mody200
رابط هذا التعليق
شارك
محمد هشام.

محمد هشام.

قام بنشر
قام بنشر
2 ساعات مضت, mody200 said:

ولاكن عند عملية البحث بين تاريخين فأن TextBox1,TextBox2,TextBox3 لايظهر قيم الليست بوكس من المبيعات والتخصيلات ورصيد ختامى

ربما عليك مراجعة هدا  

  Cnt = Cnt + 1   '===>> ' عدد الصفوف على الليست بوكس
                sum1 = sum1 + .List(R, 10) '===>> ' مجموع الصفوف الظاهرة ( عمود المبيعات)
                sum2 = sum2 + .List(R, 11) '===>> ' مجموع الصفوف الظاهرة ( عمود التحصيل)
                '====================================
                'المبيعات - التحصيل
                 tb = sum1 - sum2

بمعنى عند البحث بين تاريخين سيتم احتساب الاعمدة الظاهرة على الليست بوكس فقط 

في 20‏/7‏/2024 at 09:37, mody200 said:

وافترضنا ان تم اختيار التاريخ من 16/11/2023 حتى20/11/2023

مثلا الفترة المختارة لا يوجد اي بيانات على اعمدة المبيعات و التحصيل لهدا من الطبيعي اظهار 0 

Screenshot2024-07-21203234.png.7dfbb8dadbd2578ea99912aaa022694d.png

رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر (معدل)

انا اسف الخطاء منى انا اقصد الدائن والمدين

وتم تعديل عمود 6/7

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

رصيد اول مده + المبيعات - التحصيلات يعطى الرصيد الختامى

كشف حساب.jpg

تم تعديل بواسطه mody200
رابط هذا التعليق
شارك
  • أفضل إجابة
محمد هشام.

محمد هشام.

قام بنشر
  • أفضل إجابة
قام بنشر

يمكنك جلب اخر قيمة على الليست بوكس باستبدال هده السطور 

tb = sum1 - sum2
TextBox1.Value = Format(tb, "#,##00.00")

وجعلها هكدا  

With Application
        sum3 = .Max(.Index(Me.ListBox1.List, r, 9)) ' الرصيد الختامى
    End With
TextBox1.Value = Format(sum3, "#,##00.00")

 

Copy of كشف حساب عميل -V4.xlsm

  • Like 2
رابط هذا التعليق
شارك
mody200

mody200

قام بنشر
  • الكاتب
قام بنشر (معدل)

الف شكر لك السيد هشام محمد انت رائع حقا

انه يعمل بكفائة

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

Word او  PDF مع المعاينة قبل الطباعة

تم تعديل بواسطه mody200
رابط هذا التعليق
شارك

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

زائر
اضف رد علي هذا الموضوع....

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

×
 مشاركة
الذهاب الي قائمه المواضيع

  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information

  I accept