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

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

قام بنشر

السلام عليكم - حفظكم الله

يرجى الاطلاع على المعادلات الموجودة بشيت الوصل لوجود  نقص أو خلل فيها 

واكون ممنون وشاكر  اذا ابدلت المعدلات بكود 

جزيتم خيرا

تصحيح معادلة او عمل كود بدل المعادلات.rar

قام بنشر

وعليكم السلام

جرب الكود التالي

Sub Test()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim arr     As Variant
    Dim temp    As Variant
    Dim i       As Long
    Dim j       As Long
    Dim c       As Long
    Dim b       As Boolean
    Dim t       As Double
    
    Set ws = Sheets("السجل")
    Set sh = Sheets("وصل")
    arr = ws.Range("A4:J" & ws.Cells(Rows.Count, 1).End(xlUp).Row).Value
    ReDim temp(1 To UBound(arr, 1), 1 To 4)
    sh.Range("A4:D" & Rows.Count).ClearContents

    For i = LBound(arr, 1) To UBound(arr, 1)
        If arr(i, 2) = sh.Range("A2").Value Then
            If b = False Then
                sh.Range("B2").Value = arr(i, 3)
                sh.Range("G4").Value = arr(i, 8)
                b = True
            End If
            
            j = j + 1
            For c = 4 To 7
                temp(j, c - 3) = arr(i, c)
            Next c
            
            t = Application.WorksheetFunction.Sum(t, arr(i, 9))
        End If
    Next i
    
    If j > 0 Then
        sh.Range("F4").Value = t
        sh.Range("A4").Resize(j, UBound(temp, 2)).Value = temp
    End If
End Sub

 

  • Like 2

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