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

حسونة حسين

أوفيسنا
  • Posts

    873
  • تاريخ الانضمام

  • تاريخ اخر زياره

  • Days Won

    24

مشاركات المكتوبه بواسطه حسونة حسين

  1. قواعد المشاركة فى الموقع اضغط هنـــــــــامن فضلك لقراءة القواعد كاملة
    و بصفة خاصة نؤكدعلى ما يلي

    1- يمنع منعا باتا نشر أية مواد تخالف حقوق الملكية الفكرية و يرجى الابلاغ عن المشاركات المخالفة من خلال زر تقرير اسفل المشاركة
    2-يجب استخدام خاصيةالبحث قبل طرح السؤال توفيرا للوقت و الجهد.
    3-ضرورة كتابة عنوان واضح للموضوع يدل على محتواه ويعطي وصفاً مختصرا للسؤال.
    4-ممنوع منعا باتاً كتابة عناوين سينمائية مثل عاجل ، نداء الي فلان ، الي الخبراء ، طلب مساعدة ، أريد حلا.....
    5-يمكن استعجال الرد باستخدام تعبير -للرفع- و غير مسموح بالالحاح او اللوم فجميع الاعضاء يشاركون تطوعا طبقا لسعة وقتهم.

    ومخالفة ذلك تعرض الموضوع للحذف

     

    هذا الموضوع مخالف لقوانين المنتدي

    ××××××××

    موضوع مكرر.
    ××××××××
    يغلق
    ××××××××
    الإدارة

  2. وعليكم السلام ورحمه الله وبركاته

    تفضل اخى

    Option Explicit
    
    Sub Search_Delete()
        Dim Arr As Variant, SH As Worksheet, dic As Object
        Dim I As Long, Unique_No As String, R As Range, P As Long
        Application.ScreenUpdating = False: Application.EnableEvents = False
        Set SH = ThisWorkbook.Worksheets("ورقة1")
    
        Arr = SH.Range("B2:F" & SH.Cells(Rows.Count, 2).End(xlUp).Row).Value
    
        Set dic = CreateObject("Scripting.Dictionary")
        dic.CompareMode = 1
        For I = LBound(Arr) To UBound(Arr)
            Unique_No = Arr(I, 1) & Arr(I, 4) & Arr(I, 5)
            If Not dic.Exists(Unique_No) Then
                dic.Add Unique_No, P
                P = P + 1
            Else
                If R Is Nothing Then
                    Set R = SH.Cells(I + 1, 1)
                Else
                    Set R = Union(R, SH.Cells(I + 1, 1))
                End If
            End If
        Next I
        If Not R Is Nothing Then R.EntireRow.Delete
        Application.EnableEvents = True: Application.ScreenUpdating = True
    End Sub

     

     

    • Like 1
  3. تفضل

    احذف الكود الخاص بك الموجود في حدث الشيت

    ثم ضع هذا الكود

    Private Sub Worksheet_Change(ByVal Target As Range)
        Dim X As Range
        Application.EnableEvents = False
        For Each X In Target
            If X.Column = 2 Then
                If X.Value = "" Then
                    X.Resize(, 6).ClearContents
                Else
                    X.Offset(0, 2) = Date
                    X.Offset(0, 2).NumberFormat = "dddd yyyy/mm/dd"
                End If
            End If
        Next
         Application.EnableEvents = True
         Search_SUM
    End Sub

     

    • Like 3
    • Thanks 1
×
×
  • اضف...

Important Information