پاک کردن خط های تکراری از یک تکستباکس!

[niksalehi]

سلام، یه تکستباکس دارم، میخوام خط های تکراری رو ازش پاک کنم، یعنی اگه :
new line
new line
new line
old line
old line
new line

به این صورت باشه، اینطوری بشه:
new line
old line

ممنونم!

[arenaw]

سلام
این فانکشن هارو کپی کن توی مادژول:

Function IsMultiLine(ByVal str As String) As Boolean
If Not InStr(1, str, Chr(13) & Chr(10)) = 0 Then IsMultiLine = True
End Function
Function AllLine(ByVal str As String) As Integer
If IsMultiLine(str) = False Then
AllLine = 1
Else
Dim a$()
a = Split(str, Chr(13) & Chr(10))
AllLine = UBound(a) + 1
End If
End Function
Function ReadLine(ByVal str As String, ByVal line As Integer) As String
If IsMultiLine(str) = False Then
If line = 1 Then ReadLine = str
Else
Dim a$()
a = Split(str, Chr(13) & Chr(10))
If Not line - 1 > UBound(a) Then
ReadLine = a(line - 1)
End If
End If
End Function
Function ReadLineFromTo(ByVal str As String, ByVal forline As Integer, ByVal toline As Integer) As String
Dim i As Variant
If IsMultiLine(str) = True Then
Dim a$()
a = Split(str, Chr(13) & Chr(10))
For i = forline - 1 To toline - 1
ReadLineFromTo = ReadLineFromTo & a(i) & IIf(i <> toline - 1, vbNewLine, "")
Next i
End If
End Function
Public Function DeleteTekrariLine(ByVal str As String) As String
Dim i As Integer, j As Integer, k As Integer
Dim exist As Boolean
For i = 1 To AllLine(str)
exist = False
For j = 1 To AllLine(DeleteTekrariLine)
If ReadLine(str, i) = ReadLine(DeleteTekrariLine, j) Then exist = True
Next
If exist = False Then DeleteTekrariLine = DeleteTekrariLine & ReadLine(str, i) & vbNewLine
Next i
DeleteTekrariLine = ReadLineFromTo(DeleteTekrariLine, 1, AllLine(DeleteTekrariLine) - 1)
End Function


بعد اینجوری توی برنامت استفاده کن:

Text1 = DeleteTekrariLine(Text1)

[niksalehi]

ممنون اما وقتی روی کامند باتن کلیلک میکتم این خط رو زرد نشون میده
If IsMultiLine(str) = False Then
و
ارور زیر رو میده:
Sub or Function not defined

[arenaw]

حواسم نبود، دوباره کدهای مادژول رو کپی کنید (ویرایش کردم پست قبلو)

[SHD.NET]

سلام . من هم همین سوال رو داشتم . فقط من یه لیست باکس دارم که توش موارد تکراریه
مثلا:
حمید
حسن
حمید
حسن
حسن

ومی خوام اینهای غربال بشن و در نتیجه خروجی این بشه
حمید
حسن

میشه راهنمایی کنین . هر کاری کردم نشد.

[محسن واژدی]

سلام . من هم همین سوال رو داشتم . فقط من یه لیست باکس دارم که توش موارد تکراریه
مثلا:
حمید
حسن
حمید
حسن
حسن

ومی خوام اینهای غربال بشن و در نتیجه خروجی این بشه
حمید
حسن

میشه راهنمایی کنین . هر کاری کردم نشد.
سلام علیکم

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


Public Sub DelExtListBoxItemsA(ListBox As ListBox)
On Error Resume Next
Dim dic As New Scripting.Dictionary, i
Set dic = CreateObject("scripting.dictionary")
With ListBox
For i = 0 To .ListCount - 1
If Not dic.Exists(.List(i)) Then dic.Add .List(i), .List(i)
Next 'i
.Clear
For Each i In dic.Items
.AddItem i
Next 'i
End With
End Sub


و یا

Public Sub DelExtListBoxItemsB(ListBox As ListBox)
On Error Resume Next
Dim sLB$, i
Const sDL$ = "<DL>"
sLB$ = sDL$
With ListBox
For i = 0 To .ListCount - 1
If InStr(1, sLB$, sDL$ & .List(i) & sDL$, vbTextCompare) = 0 Then
sLB$ = sLB$ & .List(i) & sDL$
End If
Next 'i
.Clear
For Each i In Split(sLB$, sDL$, , vbTextCompare)
If i > "" Then .AddItem i
Next
End With
End Sub


البته DelExtListBoxItemsA بهینه تر است

برای مثال:

Private Sub Command1_Click()
DelExtListBoxItemsA List1
End Sub

موفق باشید