PDA

View Full Version : کار با حلقه(حذف ایمیل های تکراری)



aleas2
یک شنبه 28 مهر 1392, 14:08 عصر
سلام خسته نباشید بنده یه فایل بنام list_kol_email.txt دارم که شامل 500000 ایمیل هسته و یه لیستی هم email2.txt دارم شامل 360000 ایمیل حالا میخوام این فایل میخونم ایمیل های تکراری رو از 5000000 حذف کنم چطور اینکارو بکنم ؟

این کد به چه صورت ساده کنم که سرعت عمل بره بالا؟
For i = 0 To List1.ListCount - 1

a = False

Text2.Text = i

If InStr(1, txt2.Text, List1.List(i)) <> 0 Then a = True

DoEvents

If a = False And InStr(1, txt3.Text, List1.List(i)) <> 0 Then a = True

DoEvents

If a = False And InStr(1, txt4.Text, List1.List(i)) <> 0 Then a = True

DoEvents

If a = False Then

For j = 0 To list1000.ListCount - 1

If Trim(LCase(List1.List(i))) = Trim(LCase(list1000.List(j))) Then a = True: Exit For

DoEvents

Next

End If

If a = False Then list1000.AddItem Trim(List1.List(i))

DoEvents

Next

Open App.Path & "\listnew.txt" For Output As #1

For i = 0 To list1000.ListCount - 1

Print #1, list1000.List(i)

DoEvents

Next

Close #1

SlowCode
یک شنبه 28 مهر 1392, 16:33 عصر
سلام
اگه فقط فایل اجرایی این برنامه رو میخوای پیشنهاد میکنم که به یه اسمبلی کار بگو تا اینو برات بنویسه!
چون تعداد حلقه هات خیلی زیاد هستن و اگه اینو بخوای تو وی بی یا حتی سی پلاس پلاس اجرا کنی زمان زیادی طول میکشه.

ولی اگه میخوای با وی بی بنویسی به نظرم بهتره از جستجوی باینری استفاده کنی. این تابع رو همین الان نوشتم، تستش کن احتمالا مشکل داشته باشه:

Function Find(arr As ListBox, Key As String)

Dim L As Long, M As Long, H As Long

L = 0
H = arr.ListCount - 1
M = H \ 2

For i = 0 To arr.ListCount \ 2 + 1
If Key = arr.List(L) Then
Find = L
ElseIf Key = arr.List(M) Then
Find = M
ElseIf Key = arr.List(H) Then
Find = H
ElseIf Key < arr.List(M) And H <> 0 Then
H = M
M = H \ 2
ElseIf Key > arr.List(M) Then
L = M
M = M + H \ 2 + 1
Else
Find = -1
End If
Next
End Function


کافیه یه لیست باکس به پارامتر اول و یه مقدار به پارامتر دوم بدی تا ایندکس آیتم پیدا شده رو بهت بده.
خاصیت جستجوی باینری اینه که واسه پیدا کردن یه مورد تو آرایه مرتب خیلی سریع تر هست.
نکته: خاصیت sorted لیست باکس رو فعال کن تا جستجو درست انجام بشه.

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


بازم تاکید میکنم، سعی کن از اسمبلی برای اینکار استفاده کنی. دیگه حداقلش ++C هست.

SlowCode
یک شنبه 28 مهر 1392, 16:46 عصر
نکته دیگه هم اینه که تو این جور کارها که قراره یه عمل چند هزاربار تکرار باشه علاوه بر انتخاب الگوریتم مناسب باید از دستورات سریع استفاده کنی.
مثلا تو الان از دستورات trim , Lcase , Instr استفاده کردی که سرعتت رو به شدت کاهش میدن.
همچنین تو سه قسمت از DoEvents استفاده کردی که خیلی خیلی خیلی سرعتت رو کاهش میده.

به غیر از الگوریتم...بهینه سازی کدها و استفاده از دستورات سریع گاهی اوقات میتونه در حد چند دقیقه سرعتت رو کاهش بده.

rahnema1
دوشنبه 29 مهر 1392, 04:45 صبح
ایمیل ها رو ببر داخل یه db و با sql دستور select distict بزن

vbhamed
چهارشنبه 01 آبان 1392, 12:29 عصر
سلام
در تكميل پاسخ rahnema1 عزيز، مي‌تونيد يك جدول در ديتابيس ايجاد كنيد با فيلدي به نام Email كه كليد اصلي هم باشه
بعد يكي يكي ايميلها رو با كد به ديتابيس اضافه كنيد، چون فيلد كليد اصليه مقادير تكراري رو قبول نمي‌كنه و در نهايت هر ايميل يكبار در ديتابيس ثبت ميشه، اينطوري ديگه دستور Select distinct هم نياز نيست هر دفعه مقادير تكراري رو حذف كنه
فقط قبل از اينكار از دستور On error resume next استفاده كنيد تا موقع اضافه كردن به ديتابيس سيستم خطا نده