پرسش دادهای تکراری

[general007]

با سلام
در فایل پیوست در هنگام ثبت اطلاعات در صورتی که کد پرسنلی تکراری وارد شود پیغام میدهد که کد پرسنلی تکراری است و اجازه ثبت نمی دهد
ایا راهی هست در msgbox شماره ردیف یا ردیفهایی که کد پرسنلی قبلا ثبت شده نمایش داده شود و در صورت تایید کاربر مجدد مشخصات ثبت شود

با تشکر

[generalsamad]

با سلام
این کد رو امتحان کنید

Private Sub CommandButton3_Click()
Dim Rng As Range
Dim Rng1 As Range
Dim RowDup As Integer

If TextBox1.Text = "" Then
    MsgBox "لطفا کد پرسنلي را تکميل نماييد "
    Exit Sub
ElseIf Not IsNumeric(TextBox1.Text) Then
    MsgBox "کد پرسنلي به صورت عدد وارد شود "
    Exit Sub
End If

For Each Rng1 In Range("b1:b20")
    If TextBox1.Text = Rng1 Then
        RowDup = WorksheetFunction.Index(Range("a2:a10"), WorksheetFunction.Match(Val(TextBox1.Text), Range("B2:B10"), 0))
        Rng1.EntireRow.Interior.ColorIndex = 15
        MsgBox "اين کد پرسنلي تکراري مي باشد "
        MsgBox "شماره رديف تکراي:" & RowDup
        Rng1.EntireRow.Interior.ColorIndex = 0
        Exit Sub
    End If
Next Rng1

For Each Rng In Range("A2:A20")
    If Rng = "" Then
        Rng.Offset(0, 1) = TextBox1.Text
        Rng.Offset(0, 2) = TextBox2.Text
        Rng.Offset(0, 3) = TextBox3.Text
        Rng.Offset(0, 4) = TextBox4.Text
        Rng.Offset(0, 5) = TextBox5.Text
        Exit For
    End If
Next Rng

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""

End Sub 

[general007]

تشکر از شما
همان کاری را که میخواستم انجام میدهد
فقط ایا راهی هست که اگر شماره پرسنلی بیش از یک بارتکرار شده بود درmsgbox شماره ردیف های تکراری نمایش داده شود

[generalsamad]

بله امکانش هست باید یک حلقه ایجاد کرد و از اول تا آخر سطر شماره پرسنلی ها رو با مقدار تکست باکس مقایسه کرد که اگر برابر بود مقدار کانتر حلقه را برگرداند (در صورتی که ردیفها به ترتیب یکی یکی اضافه شوند) یا میتوان مقدار متناظر با هر ستون را در msgbox نمایش داد
البته این یک روش هست
روشهای دیگر هم وجود دارد با استفاده از ستونهای کمکی یا آرایه

[general007]

با عرض پوزش چون اطلاع کاملی از vba ندارم ایا امکانش هست در فایل نمونه ایجاد شود
تا نسبت به اون در فایل اصلیم تغیرات رو انجام دهم
تشکر از شما

[generalsamad]

Private Sub CommandButton3_Click()
Dim Rng As Range
Dim Rng1 As Range

If TextBox1.Text = "" Then
    MsgBox "لطفا کد پرسنلی را وارد کنید "
    Exit Sub
ElseIf Not IsNumeric(TextBox1.Text) Then
    MsgBox "کد پرسنلی به صورت عدد وارد شود "
    Exit Sub
End If
Dim i As Integer
For Each Rng1 In Range("b1:b20")
    If TextBox1.Text = Rng1 Then
        Rng1.EntireRow.Interior.ColorIndex = 15
        MsgBox "این کد پرسنلی تکرری می باشد "
        For i = 1 To 10
            If TextBox1.Text = Range("B" & i + 1) Then
                MsgBox "شماره ردیف تکراری:" & i
            End If
        Next i
        Rng1.EntireRow.Interior.ColorIndex = 0
        Exit Sub
    End If
Next Rng1

For Each Rng In Range("A2:A20")
    If Rng = "" Then
        Rng.Offset(0, 1) = TextBox1.Text
        Rng.Offset(0, 2) = TextBox2.Text
        Rng.Offset(0, 3) = TextBox3.Text
        Rng.Offset(0, 4) = TextBox4.Text
        Rng.Offset(0, 5) = TextBox5.Text
        Exit For
    End If
Next Rng

TextBox1.Text = ""
TextBox2.Text = ""
TextBox3.Text = ""
TextBox4.Text = ""
TextBox5.Text = ""

End Sub 

[general007]

ممنون خیلی زحمت کشیدید سوال اخر(انشااله )
در حال حاظر اکر شماره پرسنلی تکراری باشد اطلاعات ثبت نمی شود
ایا امکان دارد در صورت تکراری بودن از کاربر جهت ثبت سوال کند ( به عنوان مثال کد پرسنلی وارد شده تکراری می باشد ایا ثبت شود )
باز هم تشکر از شما

[generalsamad]

بله امکانش هست
در این قسمت از کد

For Each Rng1 In Range("b1:b20")
    If TextBox1.Text = Rng1 Then
        Rng1.EntireRow.Interior.ColorIndex = 15
        MsgBox "این کد پرسنلی تکرری می باشد "
        For i = 1 To 10
            If TextBox1.Text = Range("B" & i + 1) Then
                MsgBox "شماره ردیف تکراری:" & i
            End If
        Next i
        Rng1.EntireRow.Interior.ColorIndex = 0
        Exit Sub
    End If
Next Rng1 

به جای exit sub از msgbox استفاده کنید که اگه دکمه اوکی رو کاربر وارد کرد داده ها ذخیره شوند در غیر اینصورت exit sub انجام شود

[general007]

آمکانش هست فایل را بررسی کنید
پیغام مید هد ( چرخه به تعداد دفعات تکرار کد پرسنلی ) ادامه پیدا میکند ولی رکورد ثبت نمی شود
در صورت امکان در فایل اصلاح بفرمااید
با تشکر

[generalsamad]

با سلام

Dim Msg, Style, Title, Response
Msg = "کد پرسنلي تکراري ميباشد اطلاعات ثبت شود؟"
Style = vbYesNo + vbCritical + vbDefaultButton2
Title = "هشدار"

Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
    MsgBox "اينجا کدهاي مربوط به ثبت وارد شود"
Else
    Exit Sub
End If 

[general007]

باعرض سلام
ممنون اربابت وقتی که در اختیار بنده قرار میدهید
با توجه به اینکه در بحث vbaکاملا مبتدی هستم ، لذا از شما خواهشمندم در صورت امکان اصلاحات در فایل پیوست اعمال شود
1- در هنگام ثبت رکورد جدید ، هر بار اخرین رکورد ویرایش می شودو به ستون خالی پایین ارجاع نمی شود
2- اگر رکورد تکراری باشد اجازه ثبت نمیدهد ( در صورت امکان به کاربر پیغام دهد و درصورت تایید رکورد مجدد ثبت شود )

تشکر از شما