تصفية حساب عميل تلقائي

[ابو نبأ]

السلام عليكم

مبارك التصميم الجديد

سلمكم الله عندي سؤال :

سؤالي هو : عندي شيت مدرج فيه بيانات العملاء ، وشيت اخر مخصص تصفية حساب العميل 

المطلوب : تصفية حساب عميل (عمل فاتورة بالمبالغ المستحقة والمبالغ المدفوعة والباقي بذمته بشكل تلقائي)

وكما مبين بالمثال المرفق 

حفظكم الله وسلمكم من كل مكروه ( هذا السؤال الاول ، والاسئلة القادمة حول الموضوع تأتي تباعاً )

السلام عليكم

 

 

 

تصفية حساب عميل.rar

تم تعديل أغسطس 28, 2015 بواسطه ابو نبأ
تعديل على المثال

[ياسر خليل أبو البراء]

الأخ الكريم أبو نبأ

إليك الملف التالي ..قمت ببعض التعديلات لتحصل على النتائج منسقة بالكامل

كل ما عليك كتابة رقم العميل ثم النقر على زر الأمر .. وجرب كتابة أرقام ليست موجودة ..

Sub Treat()
    Dim WS As Worksheet, SH As Worksheet
    Dim FindName, LastRow As Long

    Set WS = Sheets("البيانات"): Set SH = Sheets("تصفية حساب العميل")

    With Application
        .ScreenUpdating = False: .Calculation = xlManual: .EnableEvents = False
    End With

    With SH
        .Range("D3:E3,B4:D4").ClearContents
        .Range("A6:E1000").Clear

        FindName = Application.Match(.Range("B3").Value, WS.Columns(2), 0)
        If IsNumeric(FindName) Then
            .Range("B4").Value = WS.Cells(FindName, "E")
        Else
            MsgBox "No Mathing Data", 64: Exit Sub
        End If

        .Range("D3").Value = Date

        WS.AutoFilterMode = False
        WS.Rows(1).AutoFilter Field:=2, Criteria1:=.Range("B3").Value
        WS.Range("H1:I" & WS.Cells(Rows.Count, "E").End(xlUp).Row).SpecialCells(xlCellTypeVisible).Copy
        .Range("A6").PasteSpecial xlPasteValues
        WS.AutoFilterMode = False

        LastRow = Selection.Rows.Count + 5
        With .Range("A" & LastRow + 1 & ":" & "B" & LastRow + 1)
            .Formula = "=SUM(A7:A" & LastRow & ")"
        End With
        .Range("C" & LastRow) = "المبلغ المتبقي"
        .Range("C" & LastRow + 1) = .Range("A" & LastRow + 1) - .Range("B" & LastRow + 1)

        .Rows(1).Copy .Range("A" & LastRow + 4)
        .Rows(LastRow + 4).Hidden = False

        With .Range("A6:B" & LastRow + 1 & ",C" & LastRow & ":C" & LastRow + 1)
            .Range("A1:B1").Interior.Color = vbYellow
            .Font.Name = "Arial": .Font.Size = 13: .Font.Bold = True
            .HorizontalAlignment = xlCenter: .VerticalAlignment = xlCenter
            .Borders.LineStyle = xlDot: .BorderAround LineStyle:=xlDot
        End With

        .Range("C" & LastRow).Interior.Color = vbYellow
        .Range("B3").Select
    End With

    With Application
        .EnableEvents = True: .Calculation = xlAutomatic: .ScreenUpdating = True
    End With
End Sub

 

Client Account Report YasserKhalil.rar

[ابو نبأ]

السلام عليكم

جزيت خيرا