استخراج الارقام المفقوده

[mhareek]

لو امكن اريد كود يبين ليى التسلسل

لو كان هناك اى رقم ناقص فى تسلسل معين يبين لى الارقام الناقصة التى لم تدرج

ولكم جزيل الشكر

والحمد للة رب العالمين

[خالد الشاعر]

الاستاذ العزيز mhareek

هذا الكود رفعة من على المنتدى فى عمل من اعمال الاستاذة الخبراء للاسف لا اتذكر الاسم واسف لعدم التذكر

ولكنة يعمل رقم اذا كان في اسم مكتوب فى الخلية المجاورة

ممكن ينفع معك

=IF(B14<>"";ROW()-13;"")

[mhareek]

مشكور اخى حنا

ولكن طلبى يختلف

فانا اقصد ان كان هناك عمود بة ارقام متسلسلة من 1 الى 1000 مثلا ولكن بينهم ارقام مفقودة لم توضع مثلا 556 اريد الكود يخبرنى ان الرقم 556 غير موجود بالتسلسل ويجب ادراجة

ولكم جزيل الشكر

تم تعديل نوفمبر 26, 2008 بواسطه mhareek

[mhareek]

للرفع

[يحيى حسين]

أخي جرب هذا الكود

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim i As Integer
    Dim x As Variant
    Dim Msg As String
    Set Sh = Worksheets("Sheet1")
    With Sh
        Set Rng = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    For i = 1 To 1000
        On Error Resume Next
        x = WorksheetFunction.Match(i, Rng, False)
        If Err <> 0 Then
            Err.Clear
            Msg = Msg & vbCrLf & i
        End If
        On Error GoTo 0
    Next i
    If Msg = "" Then
        Msg = "لا يوجد أرقام مفقودة "
    Else
        Msg = " :الأرقام المفقودة هي  " & Msg
    End If
    MsgBox Msg
End Sub

تم تعديل نوفمبر 27, 2008 بواسطه justice

[mhareek]

[جميل جدا اخى الحبييب

رائع والله

ومشكور لتجاوبك اخى الحبييب جعلة الله فى ميزان حسناتك

ملحوظة اخى الحبييب لو كتبت ارقام من 1 الى 100 مثلا بالفعل انة يبين الناقص بينهم ولكنة يكمل باقى الارقام حتى 1000 على اساس انها مفقودة مع العلم انى لم اصل اليها فى العد

وبالتالى كل مرة يجب الدخول للكود وتعديل المدى

فلو امكن تعدي المدى اوتو ماتك بدون الاظطرار للدخول كل مرة للكود

وايضا اخى الحبييب الترقيم يبدا من 1 , 2 وهكذا

ولكنى اريد ابدا من اى رقم ويعلو مثلا 1290 , 1291وهكذا

والبتالى اريد ان يكون هناك طريقة لتعديل بداية الترقيم

جزاك الله خيرا

بارك الله فيك اخى الغالى العدالة

تم تعديل ديسمبر 25, 2008 بواسطه mhareek

[ابو اسامة العينبوسي]

Sub Test()
    Dim Sh As Worksheet
    Dim Rng As Range
    Dim i As Integer
    Dim x As Variant
    Dim Msg As String
    Dim F As Integer
    Set Sh = Worksheets(1)
    With Sh
        Set Rng = .Range("A1:A" & .Range("A" & .Rows.Count).End(xlUp).Row)
    End With
    F = Application.InputBox("enter the start of series")
    For i = F To Cells(65350, 1).End(xlUp).Row
        On Error Resume Next
        x = WorksheetFunction.Match(i, Rng, False)
        If Err <> 0 Then
            Err.Clear
            Msg = Msg & vbCrLf & i
        End If
        On Error GoTo 0
    Next i
    If Msg = "" Then
        Msg = "no missing numbers "
    Else
        Msg = " :missing numbers is   " & Msg
    End If
    MsgBox Msg
End Sub

تم تعديل ديسمبر 25, 2008 بواسطه ابو اسامة العينبوسي

[ابو اسامة العينبوسي]

السلام عليكم

________________.rar

[قطان]

والسلام ختام

[mhareek]

رائع واكثر من رائع اخى الحبييب ابو اسامة

بوركت بالفعل عمل متقن

سلمت وبارك الله فيك اخى الحبييب

جعلك الله من انفع الناس للناس

وجعلها الله فى ميزان حسناتك

جزاك الله خيرا

اخى الحبييب ملحوظة بسيطة

لو بدات برقم 1290 مثلا فى او خانة ثم اكملت الترقيم

لا يعمل الكود

ويعطى لاتوجد ارقام ناقصة

يعنى لو a1 = 1290

a2=1291

وهكذا لايعمل الكود لو كان هناك رقم ناقص وليكون 1298 يعطى رسالة لايوجد ارقام مفقودة

ارجو اخى الحبييب التعديل وجزاك الله خيرا

تم تعديل ديسمبر 25, 2008 بواسطه mhareek

[ابو اسامة العينبوسي]

السلام عليكم

تفضل

[ابو اسامة العينبوسي]

السلام عليكم

________________3.rar

تم تعديل ديسمبر 26, 2008 بواسطه ابو اسامة العينبوسي

[mhareek]

الف شكر اخى الحبييب بارك الله فيك

ممتااااااااااااااااااااااااااااز

والف شكر على الاهتمام

بارك الله فيك وجعلها فى ميزان حسناتك

جزاك الله خيرا

تم تعديل ديسمبر 26, 2008 بواسطه mhareek