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

مشكلة في الفلتر


Ha Mza

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

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

Private Sub CommandButton1_Click()

 Const TableName As String = "Table5"
 Const WSdest As String = "Client ACC"
 Dim StartDate&, EndDate&, LastRow&, Col&
 Dim Tb1 As ListObject, rng As Range, Customer As String
 Set Tb1 = Range(TableName).ListObject
 Customer = Worksheets(WSdest).[H2]

 StartDate = DateSerial(Year(Date), Month(Date), Day(Date) - 100)
   EndDate = DateSerial(Year(Date), Month(Date), Day(Date) + 1)
   
Application.ScreenUpdating = False

If Me.ComboBox1.Value = "" Then: MsgBox "أختار أسم العميل حتي يمكنك عرض كشف الحساب", vbCritical, "Ah Med": Exit Sub
fc = Application.WorksheetFunction.CountIf(DA.Range("B5:B1000"), Me.ComboBox1.Value)
fm = Application.WorksheetFunction.CountIf(DA.Range("I5:I1000"), Me.ComboBox1.Value)
If fc <= 0 And fm <= 0 Then: MsgBox "أسم العميل غير موجود ", vbCritical, "Ah Med": Exit Sub

With Worksheets(WSdest)
LastRow = .Cells(.rows.Count, "E").End(xlUp).Row
        .Range("E17:R" & LastRow).ClearContents
        .Range("G11:k11,k14").ClearContents
        .[H2] = Me.ComboBox1.Value: .[G2] = Format(StartDate): .[F2] = Format(EndDate)
End With

  With Tb1
  .Range.AutoFilter field:=2, _
            Criteria1:=">=" & StartDate, _
            Operator:=xlAnd, _
            Criteria2:="<=" & EndDate
    .Range.AutoFilter field:=5, Criteria1:=Me.ComboBox1.Value
On Error Resume Next
  Set rng = Union(.ListColumns(1).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(3).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(6).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(7).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(8).DataBodyRange.SpecialCells(xlCellTypeVisible), _
        .ListColumns(9).DataBodyRange.SpecialCells(xlCellTypeVisible))
        
  End With
  rng.Copy
  Worksheets(WSdest).[E17].PasteSpecial xlPasteValuesAndNumberFormats
  [E16].Select
    Application.CutCopyMode = False
   
  Tb1.ShowAutoFilter = False
'===== sum total =========

With Worksheets(WSdest)
Col = .Cells(.rows.Count, "E").End(xlUp).Row
.[G11] = Application.WorksheetFunction.Sum(Range("H17:H" & Col))
.[H11] = Application.WorksheetFunction.Sum(Range("I17:I" & Col))
.[I11] = Application.WorksheetFunction.Sum(Range("J17:J" & Col))
.[J11] = Application.WorksheetFunction.Sum(Range("K17:K" & Col))
.[K11] = .[H11] + .[I11] + .[J11]: .[K14] = .[G11] - .[K11]
End With
Application.ScreenUpdating = True

End Sub

 

 

Storm - نسخة.rar

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

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