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

الردود الموصى بها

قام بنشر

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

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

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

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

Formula

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

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

 

 

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

  • Like 3
قام بنشر

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

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

  • Like 3
قام بنشر

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

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

الكود

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المطلوب فى العمود الأصفر عند اختيار كود معين فى خلية لا يتم تكراره فى الخلية التالية 

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

قام بنشر

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

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

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

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

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

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

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

exc.PNG

wxc2.PNG

SALIM_DV3.xlsm

قام بنشر

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

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

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

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

Untitled.png

  • Like 3
قام بنشر

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

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

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

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

CapExcel.PNG

زائر
هذا الموضوع مغلق.
  • تصفح هذا الموضوع مؤخراً   0 اعضاء متواجدين الان

    • لايوجد اعضاء مسجلون يتصفحون هذه الصفحه
×
×
  • اضف...

Important Information