اذهب الي المحتوي
أوفيسنا
بحث مخصص من جوجل فى أوفيسنا
Custom Search

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

قام بنشر

السلام عليكم - رمضان مبارك - تقبل الله الطاعات - وعافكم الله من كل سوء ووباء

عندي ملف يحتوي على ( بيانات + تقرير )

البيانات يتم به ادراج المشتريات حسب التاريخ والمورد

اريد عمل تقرير بالمشتريات حسب التاريخ والمورد

جمع يوم + مورد.xlsx

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

زيادة في اثراء الموضوع و بعد اذن الاخ علي 

هذا الكود

Option Explicit

Sub get_value()
Dim D As Worksheet, R As Worksheet
Dim RgD As Range, RgR As Range
Dim Dic As Object, x%, y%, m%, ky
Set D = Sheets("Data"): Set R = Sheets("Repport")
Set RgD = D.Range("A2", D.Range("A1").End(4))
Set RgR = R.Range("A2", R.Range("A1").End(4))
Set Dic = CreateObject("Scripting.Dictionary")
If R.Range("E1").CurrentRegion.Rows.Count > 1 Then _
 R.Range("E1").CurrentRegion.Offset(1).ClearContents
m = 2
  For x = 2 To RgR.Rows.Count + 1
   For y = 2 To RgD.Rows.Count + 1
    If D.Cells(y, 1) = R.Cells(x, 1) Then
     Dic(D.Cells(y, 1) & "*" & D.Cells(y, 3)) = _
     Dic(D.Cells(y, 1) & "*" & D.Cells(y, 3)) + D.Cells(y, 2)
    End If
  
   Next
   For Each ky In Dic.keys
    R.Cells(m, "E") = Format(CDate(Split(ky, "*")(0)), "yyyy/mm/dd")
    R.Cells(m, "F") = Dic(ky)
    R.Cells(m, "G") = Split(ky, "*")(1)
    m = m + 1
    Next ky
   Dic.RemoveAll
  Next
End Sub

الملف مرفق

 

Mouwaredine.xlsm

  • Like 2
  • Thanks 1

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