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

[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

موفق باشید