جستجوي ركوردهاي جديد از يك ليست متغير و ثبت آنها در يك ليست ثابت

**arsalan135** · 2014/02/28, 22:46

و توضیح دیگر اینکه در شیت ثبت اطلاعات موقت ، اطلاعات در هر لحظه ممکن است تغییر کند بدین معنی که احتمال تغیر کل لیست در شیت ثبت اطلاعات موقت می باشد و چنانچه ثبت اطلاعات جدید بصورت خودکار در شیت بانک اطلاعات ( بایگانی ) صورت نگیرد در حقیقت بخشی از اطلاعات را از دست داده ایم.

**~M*E*H*D*I~** · 2014/03/01, 15:18

نوشته اصلی توسط arsalan135

با سلام خدمت دوستان
توي يك فايل اكسلي كه براي يكي از دوستانم تهيه مي كنم به اين مسئله رسيدم و از اين قراره كه در يك ليستي كه بصورت موقت و هر روز متغير است مشخصات افراد ( در شيت ثبت اطلاعات موقت ) ثبت مي شود. حال نياز است كه اطلاعات كليه افراد در يك ليست جداگانه ( شيت بانك اطلاعات )نگهداري شود . با توجه به اينكه كاربري كه مسئول ثبت اطلاعات مي باشد خيلي با اكسل آشنايي ندارد ،( همينطور خود بنده

) كه از وي بخواهيم افرادي كه براي نخسين بار اطلاعات آنها در ليست موقت ثبت مي شود ، مشخصات آنها در شيت بانك اطلاعات وارد كند ، و قطعا احتمال بروز خطاي كاربري زياد است ، احتمال فراموشي كاربر و از اين دست مسائل ، بدنبال راهكاري هستم بگونه ايكه كدي در شيت "ثبت اطلاعات موقت" يا " بانك اطلاعات" هر كدام كه اساتيد صلاح مي دانند ، بصورت فعال ( نه بصورت ماكرو كه نياز به اجراي آن توسط كاربر باشد) باشد كه به محض اينكه ركورد جديدي ثبت شود كه در ليست بانك اطلاعات وجود ندارد ، اطلاعات اين ركورد ( يك يا چند فيلد از آن كه مد نظر است ) به صورت اتوماتیک به بانك اطلاعات اضافه گردد . البته نيازي نيست كه در بانك اطلاعات ، ركورد جديد بصورت مرتب شده سورت گردد ، در همين حد كه به انتهاي ليست بانك اطلاعات اضافه گردد كافي مي باشد.
لینک دانلود فایل نمونه
Download File : List_1.xlsx

ممنون از توجه دوستان و اساتيد گرامي
قابل ذکر اینکه بصورت دستی چنین کاری انجام شده ، فقط نیاز دارم که بصورت اتوماتیک اینکار صورت بگیرد

طبق فایل پیوست به نظر میرسه قصد دارید اطلاعات در شیت بدون واسطه وارد بشه این روش مناسب نیست چرا که تنها رویداد در دسترس worksheet_change هست این کار رو هم برای کاربر سخت میکنه هم برای شما که قراره فایل رو آماده کنید برای ورود اطلاعت حتما باید از فرم بهره ببرید،در این فرم با فشردن کلید ثبت علاوه بر ثبت در شیت موقت یک کد فراخوانی میشه و کدملی رو در شیت بانک جستجو میکنه اگر بود پیغام میده موجوده اگر نبود ثبت می کنه و پیام میده که ثبت شد ، کار ساده هست هر کدوم از مدیران قادرند انجام بدن این کار رو

**arsalan135** · 2014/03/01, 23:51

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

**امين اسماعيلي** · 2014/03/02, 11:54

با درود
کار کار پیچیده ای نیست. منظور جناب وطن پرست اینه که چون روی فایل تغییرات ممکنه ایجاد بشه ایونت تغییر شیت برای کد نویسی مقول نیست . حالا با اکتیو شدن یا زدن یه button بهتر میشه. اما اینطور که به نظر میرسه شما یه لیستی داری که از اینترنت وارد یه شیت میشه حالا مثلا با توجه به کد ملی میخوای ببینی اگر این کدملی ها توی شیت بانک شما نیست خودکار بره زیر اونها وارد بشه. اگر اینطور باشه بمثلا با یه حلقه for و مثلا یه if یا countif (این دومی بهتره . سرعتش بیشتره) اون کد ملی رو تو شیت بانک برسی در صورت اینکه نبود کپی و در اون شیت پیست میکنی. همین

مورد بعدی فایل رو تو همین سایت آپلود کن دوست من

**arsalan135** · 2014/03/02, 12:42

جناب اسماعيلي دقيقا همين چيزي كه شما مي فرمائيد ، مورد نياز بنده است . حالا اين كد نويسي رو چگونه بايد بنويسم اصلا سررشته اي ندارم ، چنانچه برايتان مقدور است راهنمايي كنيد . شما فرض كنيد سه ستون با عنوانهاي كد ملي ، نام و نام خانوادگي ، نام پدر كه تقريبا در هر آپديتي 600 -700 نفر (رديف ) رو شامل ميشه .
ممنون از توجه شما

**shamsololama** · 2014/03/02, 13:02

با درود فراوان
با توجه به توضیحات شما و همچین توضیحات دوستان خوبم و سپاس فراوان از ایشان این کد رو برای شما نوشتم ببین همان چیزی است که مد نظر شماست یا نه

کد PHP:


Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim n, m
For Each c In Sheet2.Range("A1:A1000")
m = Application.WorksheetFunction.CountIf(Sheet1.Range("A1:a1000"), c.Value)
n = Application.WorksheetFunction.CountA(Sheet1.Range("A1:a1000"))
    If c.Value <> "" And c.Offset(0, 1) <> "" And c.Offset(0, 2) <> "" And m = 0 Then
    Sheet1.Range("A1").Offset(n, 0).Value = c.Value
    Sheet1.Range("A1").Offset(n, 1).Value = c.Offset(0, 1).Value
    Sheet1.Range("A1").Offset(n, 2).Value = c.Offset(0, 2).Value
    
    End If
Next
End Sub

فایل نیز پیوست کردم

فایل های پیوست شده

List_1.xlsm (26.0 کیلو بایت, مشاهدات 59)

**امين اسماعيلي** · 2014/03/02, 13:27

با درود
کار استاد شمس که درسته و هیچ حرفی من حد اقل هیچ وقت روش نمیارم
منم یه کد مینویسم به این صورت که همه داده ها تونو بیاره از شیت موقت تو بانک و بعدش بگرده اگر تکراری وجود داشت (یعنی هر سه ستون تکراری باشن) رو پاک کنه

کد:

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim lastrow As Long
With Sheet1

 lastrow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
                           
 End With
    Sheet1.Range("A2:C" & lastrow).Select
    Selection.Copy
 Sheet2.Select
    Dim m
    m = Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
    

    Sheet2.Range("A" & m + 1).Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    '#####################333
Dim s
    s = Application.WorksheetFunction.CountA(Sheet2.Range("A:A"))
    
     Sheet2.Columns("A:C").Select
    Sheet2.Range("$A$1:$C$" & s).RemoveDuplicates Columns:=Array(1, 2, 3), _
        Header:=xlYes
If Sheet1.Range("A2").Value <> "" Then
Sheet1.Range("A2:C" & lastrow).ClearContents

End If
Sheet1.Select
Application.ScreenUpdating = True

End Sub

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

کد:

 Sheet2.Range("$A$1:$C$" & s).RemoveDuplicates Columns:=Array(1), _
        Header:=xlYes

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