مشکل در اضافه کردن داده تکراری جستجو شده

[samiasoft]

سلام

کد زیر متن خاصی رو جستجو میکنه و سپس انها را در لیست باکس اضافه میکنه

اما مشکل من این هست که متن های تکراری رو اضافه نمیکنه!



Const a As String = "<P dir=rtl>"
Const b As String = "</P>"
Dim j%, k%, f



Do
j = InStr(1, Text, a, vbTextCompare)
If j = 0 Then Exit Do
f = InStr(j, Text, b, vbTextCompare) - j + Len(b)
List1.AddItem Mid$(Text, j, f)
Text = Replace(Text, Mid$(Text, j, f), "")
Loop


سورس برنامه رو هم ضمیمه کردم
ممنون میشوم راهنمایی کنید کجا رو باید تغییر بدم

[سید حمید حق پرست]

سلام علیکم
بخاطر دستور Replace هستش که تکراری ها هم حذف میکنه
اگر هر یک از متنها در یک لاین باشه میتونید از کد زیر استفاده کنید :
Option Explicit

Private Sub Command_Click()
Const a As String = "<P dir=rtl>"
Const b As String = "</P>"
Dim j%, k%, f

Dim i As Integer
For i = 1 To 100
Do
j = InStr(1, Text, a, vbTextCompare)
If j = 0 Then Exit Do
f = InStr(j, Text, b, vbTextCompare) - j + Len(b)
List1.AddItem Mid$(Text, j, f)
Text = Mid(Text, 1 + InStr(Text, vbNewLine))
Loop
Next i
End Sub
سورس خودتون هم ویرایش و ضمیمه کردم.
موفق باشید.

یا علی (ع)

[samiasoft]

تشکر جناب سید حمید حق پرست

اما متنهای من در یک لاین نیستند
یعنی ممکن هست در یک لاین متنم بیش از یه بار هم وجود داشته باشه
من میخواهم متنم هر قسمتی بود این عمل جستجوی متنهای تکراری انجام بشه.
برای مثال متنهای من بصورت زیر هستش


<P dir=rtl>22</P>http://samisoft.ir/<P dir=rtl>11111</P><P dir=rtl>33</P>http://gmail.google.com/
http://samisoft.ir/<P dir=rtl>33</P>
http://gmail.google.com/<P dir=rtl>22</P>http://gmail.google.com/
http://gmail.google.com/<P dir=rtl>11</P>http://samisoft.ir/http://mihanblog.com/<P dir=rtl>22</P>
http://mihanblog.com/<P dir=rtl>33</P>
<P dir=rtl>33</P><P dir=rtl>22</P>
http://goftoman.net/forum.php
http://goftoman.net/forumffffffffff.php

http://goftoman.net/forum.php

<P dir=rtl>22</P>

http://goftoman.net/forum.php<P dir=rtl>2e2</P>

[mehran901]

بیا دوست عزیز

Option Explicit

Private Sub Form_Load()
Const a As String = "<P dir=rtl>"
Const b As String = "</P>"
Dim j%, k%, f


j = InStr(1, Text, a, vbTextCompare)
Do

If j = 0 Then Exit Do
f = InStr(j, Text, b, vbTextCompare)

List1.AddItem Mid(Text, j, f - j + Len(b))
j = InStr(f, Text, a, vbTextCompare)



Loop

End Sub