منع التكرار من قائمة منسدلة

[وائل عبد الصمد]

السلام عليكم 

هل فى طريقة لمنع التكرار اثناء الكتابة فى عمود هو فى الأساس قائمة منسدلة ؟ 

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

[Ali Mohamed Ali]

وعليكم السلام -كان لزاما عليك من البداية رفع ملف وشرح عليه المطلوب بكل دقة تجنبا لعدم اهدار الوقت

فخطوات عمل التقييد ومنع ادخال المكرر في عمود كالتالى :

نقوم باختيار من قائمة Data 

data Validation   ثم Setting وبعد ذلك Custom وبعد ذلك تقوم بلصق هذه المعادلة في المكان المخصص لذلك في Formula وذلك للتقيد في العمود الأول A

Formula

=COUNTIF($A$1:A1,A1)=1

وهذا هو ملف العمل

 

 

تقييد المدخلات.xlsx

[Ali Mohamed Ali]

اجعل عمود التقييد هو العمود الذى تأخذ منه البانات للقائمة المنسدلة 

او كما اخبرتك من قبل لتجنب عدم اهدار الوقت فعليك برفع الملف موضح عليه المطلوب بكل دقة

[سليم حاصبيا]

عليك برفع الملف موضح عليه المطلوب بكل دقة

لكن ربما ينفع هذا المثال

الكود

Sub ad_val_unique1()
Dim Ar(), k%, st$, i%, m%
Dim my_rg As Range
k = 1
Dim LA%: LA = Cells(Rows.Count, 1).End(3).Row
Set my_rg = Range("A2:A" & LA)
 my_rg.Validation.Delete
   For i = 2 To LA - 1
        For m = i + 1 To LA
            ReDim Preserve Ar(1 To k)
            Ar(k) = my_rg.Cells(m - 1)
            k = k + 1
        Next
            st = Join(Ar, ",")
    With my_rg.Cells(i - 1).Validation
        .Delete
        .Add Type:=xlValidateList, Formula1:=st
    End With
    k = 1: Erase Ar: st = ""
 Next
End Sub

النموذج مرفق

 

Var_DV.xlsm

[سليم حاصبيا]

نموذج اخر عن هذا الموضوع

Option Explicit

Sub test()
Rem===>> created by salim Hasbaya On 28/8/2109
Dim Big_Ro%, Smal_Ro%, t%, i%, x
Dim cont%, k%, my_arr(), z1%, z2%
Dim BiG_range, Smal_range As Range
Dim ro%, My_val
Big_Ro = Cells(Rows.Count, 1).End(3).Row
Smal_Ro = Cells(Rows.Count, 3).End(3).Row

Set BiG_range = Range("A1:A" & Big_Ro)
Set Smal_range = Range("C1:C" & Smal_Ro)
Smal_range.Interior.ColorIndex = xlNone
    k = 1
    For x = 1 To Smal_Ro
       '===========================
        For t = 1 To Big_Ro
        z1 = Application.CountIf(Smal_range, Range("A" & t))
        z2 = Application.CountIf(Range("a1:a" & t), Range("a" & t))
           If z1 = 0 And z2 = 1 Then
                 ReDim Preserve my_arr(1 To k)
             my_arr(k) = Range("a" & t)
             k = k + 1
            End If
         Next t
On Error Resume Next
        With Range("C" & x + 1).Validation
         .Delete
         .Add xlValidateList, Formula1:=Join(my_arr, ",")
        End With
 Err.Number = 0
       '=============================
      My_val = my_arr(1): k = 1: Erase my_arr
    Next x
  With Range("C" & x)
     .Interior.ColorIndex = 6
     .Select
      ' يمكن ازالة الفاصلة العليا من امام السطر التالي
      'لادراج اول عنصر من القائمة المنسدلة التي تلي الموجودين
'     .Value = My_val
 End With
End Sub
'++++++++++++++++++++++++++++++++++++++

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
 Dim x_ro%
 x_ro = Cells(Rows.Count, 3).End(3).Row
 Dim My_rg As Range
 Set My_rg = Range("C2:C" & x_ro)
  If Not Intersect(Target, My_rg) Is Nothing _
   And Target.Count = 1 Then
   test
  End If
 Application.EnableEvents = True
End Sub

الملف للتجربة

 

 

Smart_DV.xlsm

[وائل عبد الصمد]

قائمة منسدلة.xlsxالمطلوب فى العمود الأصفر عند اختيار كود معين فى خلية لا يتم تكراره فى الخلية التالية 

يفضل لو الحل بمعادلة متاح يكون افضل لو مش متاح هل فى حل بالتنسيق الشرطى انه يظهر الخلية المكررة بلون معين ؟

[سليم حاصبيا]

كان يجب منذ البداية ارفاق الملف 

تم معالجة الامر

 

SALIM_DV.xlsm

[وائل عبد الصمد]

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

اسف اخى الفاضل ولكن الملف لا يوجد به حل بالعكس تم الغاء القائمة المنسدلة فى العمود باللون الأصفر وايضا يسمح بالتكرار

وانا اريد ان تظل القائمة المنسدلة موجودة وفى نفس الوقت لا يسمح بالتكرار 

حملته تانى وجربت نفس المشكلة تم الغاء القائمة المنسدلة ويسمح بالتكرار عادى جدا

تقريبا هناك مشكلة فى الملف عند تحميله عندى

الأوفيس عندى 2016 عند فتح الملف تظهر هذه الرسائل

وهذا هو الملف بعد الموافقة على رسائل الأوفيس

SALIM_DV3.xlsm

[Ali Mohamed Ali]

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

هذا ما أخبرتك به أستاذ وائل ونخبر به جميع اخوانا كما اخبرك الأستاذ سليم فلابد من رفع الملف من البداية لتوضيح المشكلة بطريقة دقيقة وتجنبا لعدم اهدار وقت الأساتذة الثمين  ..فانت لا تعرف اوقاتهم 

أستاذ وائل ملف الأستاذ سليم يعمل معى بكل كفاءة ,عليك بإلغاء المدخلات القديمة في هذا العمود وحاول الإدخال مرة أخرى ولاحظ الفرق

شوف بنفسك الملف يعمل معى بكل كفاءة -هذه المشكلة من عندك

[وائل عبد الصمد]

طب الحل معمول بكود ولا معادلة ؟

لأنى جربت كتير مش عارف فين المشكلة فى الملف

جزاكم الله خيرا شاكر جدا على تعبكم واسف على الإطالة

[Ali Mohamed Ali]

طبعا بكود لا يمكن عمل هذا بمعادلة ابدا

[سليم حاصبيا]

في الملف عندك ورقة غريبة لا يمكن حذفها ولا حتى فتحها ولا أعرف كيف اتت الى عندك (خطأ بالـــ   System)

وهي سبب هذه الرسالة 

أقترح حذف الملف بالكامل وانشاء ملف جديد مع الكود 

انظر الى الصورة