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

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

قام بنشر

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

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

Sub SearchCar()
    Dim ws      As Worksheet
    Dim sh      As Worksheet
    Dim lr      As Long
    Dim last As Long
    Dim x       As Long
    Dim i       As Long

    Application.ScreenUpdating = False
        Set sh = Sheets("البحث")
        x = 4
        
        last = IIf(sh.Cells(Rows.Count, "I").End(xlUp).Row <= 4, 4, sh.Cells(Rows.Count, "I").End(xlUp).Row)
        With sh.Range("A4:M" & last)
            .ClearContents: .Borders.Value = 0: .Interior.Color = xlNone: .Font.Bold = False
        End With
        
        If sh.Cells(1, "G").Value = "" Or sh.Cells(1, "G").Value = 0 Then Exit Sub
        
        For Each ws In Sheets(Array("بنزين", "كاز", "نفط"))
            lr = ws.Cells(Rows.Count, "M").End(xlUp).Row
            For i = 2 To lr
                If ws.Cells(i, "F").Value = sh.Cells(1, "G").Value Then
                    sh.Cells(x, 1).Value = x - 3
                    sh.Cells(x, 2).Resize(1, 12).Value = ws.Cells(i, 2).Resize(1, 12).Value
                    x = x + 1
                End If
            Next i
        Next ws
        
        If x = 4 Then Exit Sub
        sh.Range("A4:M" & x - 1).Borders.Value = 1

        sh.Cells(x, "I").Value = "المجموع"
        sh.Cells(x, "J").Value = Application.WorksheetFunction.Sum(sh.Range("J4:J" & x - 1))
        sh.Cells(x, "L").Value = Application.WorksheetFunction.Sum(sh.Range("L4:L" & x - 1))
        
        With sh.Range("I" & x & ":M" & x)
            .Font.Bold = True: .Borders.Value = 13: .Interior.Color = vbCyan
        End With
    Application.ScreenUpdating = True
End Sub

بحث عن رقم السيارة في كافة الشيتات الموجودة.rar

  • Like 1

انشئ حساب جديد او قم بتسجيل دخولك لتتمكن من اضافه تعليق جديد

يجب ان تكون عضوا لدينا لتتمكن من التعليق

انشئ حساب جديد

سجل حسابك الجديد لدينا في الموقع بمنتهي السهوله .

سجل حساب جديد

تسجيل دخول

هل تمتلك حساب بالفعل ؟ سجل دخولك من هنا.

سجل دخولك الان
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information