[حل شده] حذف تکراری ها در لیست باکس

[ali.b]

سلام وقتتون بخیر دوستان عزیز

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

[s.cheraghi]

سلام
از شئ Collection استفاده کن
هر مورد رو به این شئ اضافه کن و با استفاده از بررسی خطای ایجاد شده، داده تکراری رو وارد نکن

[ali.b]

اگه ممکنهدر قالب فایل نمونه نمایش بدین ممنون می شم

[s.cheraghi]

به دلیل الزام مدیران، حتی الامکان از گذاشتن فایل نمونه معذوریم

Private Sub UserForm_Activate()
Dim Cell As Range
    Dim NoDupts As New Collection
On Error Resume Next
For Each Cell In ActiveSheet.Range("A1:A15") 
NoDupts.Add Cell.Value, CStr(Cell.Value)
Next Cell
For Each Item In NoDupts
ListBox1.AddItem Item
Next Item
End Sub 

[ali.b]

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

درضمن دوستان بزرگواری مانند iranweld و اقای قاسمیان عزیز فایل اپلود می کنن

[s.cheraghi]

بعد از اضافه کردم موارد به شئ Collection، با بررسی خطا (Err.Number <> 0) شماره سطری که تکراری نیست بدست میاد. اعداد سطر رو به لیست باکس اضافه کنین

[s.cheraghi]

دوست عزیز

سیاست سایت همیشه بر این اساس بوده که مطالب آموزنده درون پست ها قرار بگیره و نیازه به دانلود نباشه، مگر اینکه واقعا این کار نشدنی باشه!
گذاشتن فایل آماده برای پاسخ دهنده همیشه راحت تر بوده و نیازی به توضیح واضحات نداشته، اما تأکید بر آن است که با دادن راهنمایی مناسب، سوال کننده به راه حل برسد که این به مراتب آموزش قوی تری برای فرد ایجاد میکنه.
اینکه برای هر سوال فورا فایل جواب به صورت آماده قرار داده بشه صرفا رفع نیاز مقطعی فرد است و هیچ آموزش پایداری به وجود نمیاره

نکته آخر اینکه با توجه به کسب مدال آموزش vba، انتظار میرفت توضیحات کافی باشه و با تغییرات مناسب در کد بنده به جواب موردنظر برسین!

موفق باشین

[ali.b]

دوست همانطور که صجبتی که قبلا بنده با جناب اقای قاسمیان داشتم، قرار بود اصول کار این انجمن در یک لینک مجزا به صورت get and share ایجاد بشه
یعنی محیطی مجزا برای متخصصین که هر جا سوالهای تخصصی داشتن و دنبال راه حل های خاصی می گردن ایجاد شه تا تیپ پاسخی که دریافت میکنن با کاربران عادی فرق داشته باشه
بنده طرح اجرایی که در دانشگاه محل تحصیل خود M.I.T امریکا قبلا اجرا شده بود رو گفتم اینجا اجرا شه
اگر سوالی میشود انتظار پاسخ جامع می رود تا با کدی که بنده قبلا نوشتم مقایسه گردد. و در انتها کد درست جایگزین و به صورت یک پک در بخشی دیگر منتشر میگردد.
توضیحی که شما دوست عزیز دادین برای حل مشکل من کافی نبوده چون بنده کدشو از قبل نوشته بودم اما برای تنها یک ستون اعمل می شد و به این دلیل خواستار نوشتن کد جامع را کردم. به این دلیل اصرار دارم نوشته باشه تا مشکلاتی که دارم حل شه
ممنون ازوقتی که در اخیتار گذاشتین

[s.cheraghi]

دوست همانطور که صجبتی که قبلا بنده با جناب اقای قاسمیان داشتم، قرار بود اصول کار این انجمن در یک لینک مجزا به صورت get and share ایجاد بشه
یعنی محیطی مجزا برای متخصصین که هر جا سوالهای تخصصی داشتن و دنبال راه حل های خاصی می گردن ایجاد شه تا تیپ پاسخی که دریافت میکنن با کاربران عادی فرق داشته باشه
بنده طرح اجرایی که در دانشگاه محل تحصیل خود M.I.T امریکا قبلا اجرا شده بود رو گفتم اینجا اجرا شه

متأسفانه یا خوشبختانه طرح اجرایی که در دانشگاه محل تحصیل شما اجرا شده اینجا پیاده نشده!

اگر سوالی میشود انتظار پاسخ جامع می رود تا با کدی که بنده قبلا نوشتم مقایسه گردد و در انتها کد درست جایگزین و به صورت یک پک در بخشی دیگر منتشر میگردد. توضیحی که شما دوست عزیز دادین برای حل مشکل من کافی نبوده چون بنده کدشو از قبل نوشته بودم اما برای تنها یک ستون اعمل می شد و به این دلیل خواستار نوشتن کد جامع را کردم. به این دلیل اصرار دارم نوشته باشه تا مشکلاتی که دارم حل شه
ممنون ازوقتی که در اخیتار گذاشتین.

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

موفق باشین

[iranweld]

با سلام

با استفاده از Advance fillter یک لیست از غیر تکراری ستون b شیت یک در شیت دوم تهیه گردید و با فراخوانی دیتای ستونهای دیگر با vlookup یک لیست بدون تکرار از ستونهای مد نظر تهیه گردید.
با کلیک بر روی باتن تعبیه شده ابتدا ماکرو جهت تهیه غیر تکراری فراخوانی شده و پس از آن مقادیر در listbox قرار میگردد

Sub UniqueCopy()

 Sheet2.Columns(2).Clear
 On Error Resume Next
 Sheet1.Select
    With ActiveSheet
         
             
             .Range("B1", .Range("B65536").End(xlUp)).AdvancedFilter _
             Action:=xlFilterCopy, CopyToRange:=Sheet2.Range("B1"), Unique:=True
             
            
    End With
    
    Z = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row
    For i = 1 To Z
    Sheet2.Range("c" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,2,FALSE)"
    Sheet2.Range("d" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,3,FALSE)"
    Sheet2.Range("e" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,4,FALSE)"
    Sheet2.Range("f" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,5,FALSE)"
    Sheet2.Range("g" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,6,FALSE)"
    Sheet2.Range("h" & i).Formula = "=VLOOKUP($B" & i & ",Sheet1!B:H,7,FALSE)"
    Next
On Error GoTo 0
End Sub 

Private Sub UserForm_Initialize()

UniqueCopy

Z = Sheet2.Cells(Sheet2.Rows.Count, "B").End(xlUp).Row

With ListBox1

.ColumnCount = 5

.ColumnWidths = "50;50;50;50;50"

.ColumnHeads = True

.RowSource = "=Sheet2!B1:F" & Z


End With


End Sub