مكتبة الموقع - العملاء

[رشاد احمد]

اعرض الملف

العملاء

---

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

فى هذا الملف البسيط أمل من الساده الخبراء كيفية عمل كشف حساب من صفحة البيانات عند اختيار العميل من الخليه G1 من صفحة البيانات 

وان امكن بكود مع تمياتى للكل بوافر التوفيق 

---

• صاحب الملف
  رشاد احمد
• تمت الاضافه
  21 ديس, 2023
• الاقسام
  قسم الإكسيل

 

[محمد هشام.]

Public Property Get ws() As Worksheet: Set ws = Feuil1
End Property
Public Property Get Dest() As Worksheet: Set Dest = Feuil2
End Property

Sub Filtre()
  Rng = ws.Range("A4:H" & ws.[A65000].End(xlUp).Row).Value
  Col = 3: date1 = Dest.Range("D2"): date2 = Dest.Range("F2"): S = 1: P = ws.Range("G1")
  On Error Resume Next
  If date1 > date2 Then: Exit Sub
  For i = 1 To UBound(Rng)
    If Rng(i, Col) >= date1 And Rng(i, Col) <= date2 And Rng(i, S) = P Then n = n + 1
  Next i
  J = 0
  Dim réf(): ReDim réf(1 To n, 1 To UBound(Rng, 2))
  For i = 1 To UBound(Rng)
    If Rng(i, Col) >= date1 And Rng(i, Col) <= date2 And Rng(i, S) = P Then
      J = J + 1: For K = 1 To UBound(Rng, 2): réf(J, K) = Rng(i, K): Next K
    End If
  Next i
  Dest.Range("A4:H100").ClearContents
  Dest.[A4].Resize(UBound(réf), UBound(réf, 2)) = réf
   On Error GoTo 0
End Sub

 

العملاء.xlsm

تم تعديل ديسمبر 22, 2023 بواسطه محمد هشام.

[محمد هشام.]

او 

Sub Filtre2()
Dim wb As Workbook, ws As Worksheet, Dest As Worksheet
Set wb = ThisWorkbook: Set ws = wb.Sheets("البيانات"): Set Dest = wb.Sheets("كشف حساب")

Dim I&, Col&, ligne&, rng As Range

    Col = 1
ligne = ws.Cells(Rows.Count, Col).End(xlUp).Row

Application.ScreenUpdating = False
Dest.Range("A4:H100").ClearContents
 
    For I = 4 To ligne
     
If ws.Cells(I, Col) = ws.[G1] And ws.Cells(I, Col + 2) >= Dest.[D2] And ws.Cells(I, Col + 2) <= Dest.[F2] Then
   
       Set rng = ws.Range(ws.Cells(I, 1), ws.Cells(I, 8))
       
        Dest.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Resize(1, 8).Value = rng.Value
      End If
    
    Next I
Application.ScreenUpdating = True

End Sub

 

[رشاد احمد]

اشكركم وبارك الله فيكم على الاستجابه مع تمياتى لكل فريق الاداره والساده الاعضاء بدوام التوفيق