مشكلة في الترقيم التلقائي

[MSAAE]

عندي عمود B يحتوى على أسماء المستخدمين

والعمود A يحتوى على الترقيم التلقائي

المطلوب

الترقيم التلقائي يتجاوز الترقيم إذا تكرر الأسم في الخلية B

 

مثال

محمد رقم 1

أحمد رقم 2

علي رقم 3

محمد ( بدون رقم لإنه مكرر )

حسين 4

وهكذا ...

حاولت كثيراً واستخدمت دالة countif مضافاً إليها دالة max ولكن بدون جدوى

 

وشكراً وأعتذر عن الإزعاج

 

[عبدالله بشير عبدالله]

السلام عليكم

دالة countif مضافاً إليها دالة max  ضعها في a2 ثم اسحبها للاسفل

=IF(COUNTIF($B$2:B2; B2)=1; MAX($A$1:A1)+1; "")

ملف

ترقيم بتجاوز المكرر.xlsx

تم تعديل منذ 10 ساعات بواسطه عبدالله بشير عبدالله

[محمد هشام.]

وعليكم السلام ورحمة الله تعالى وبركاته 

حل اخر بإستخدام الأكواد 

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
   Dim lastRow As Long, i As Long, n As Long, tmp As Variant, a As Object
    If Intersect(Target, Me.Columns("A:B")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    On Error Resume Next
    lastRow = Me.Columns("A:B").Find(What:="*", _
    SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
    On Error GoTo 0
    
    If lastRow < 2 Then GoTo CleanUp
    Me.Range("A2:A" & lastRow).ClearContents
    tmp = Me.Range("B2:B" & lastRow).Value: Set a = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(tmp)
        If Len(Trim(tmp(i, 1))) > 0 And Not a.exists(tmp(i, 1)) Then
            n = n + 1: a(tmp(i, 1)) = n: Me.Cells(i + 1, "A").Value = n
        End If
    Next i

CleanUp:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
End Sub

 

ترقيم بتجاوز المكرر.xlsb

[MSAAE]

شكراً أخي الفاضل عبد الله بشير

والأخ الفاضل محمد هشام

 

تمت تجربة الملفين ويعملان بنجاح

كل الود والتقدير لشخصكما الكريم 🙂