Solved

Hi, if I have a list of words (see below), how can I add them into an array in order and no duplicate?

Posted on 2003-12-11
4
230 Views
Last Modified: 2010-05-01
Hi, if I have a list of words (see below), how can I add them into an array in order and no duplicate?

abc
bbb
djs
opl
abc
knda
bbb
opl
vvv
0
Comment
Question by:musclejack
  • 3
4 Comments
 
LVL 6

Accepted Solution

by:
prasitlee earned 500 total points
ID: 9924754
Dear musclejack,
     Try the following code. I am strongly sure that my code would answer your problem.

Option Explicit

Private Sub Command1_Click()

    Dim arrMeng As Variant
    Dim i As Integer
    Dim strMeng As String
   
    arrMeng = Array("abc", "bbb", "djs", "opl", "abc", "knda", "bbb", "opl", "vvv")
   
    QuickSort arrMeng
    strMeng = ""
    For i = 0 To UBound(arrMeng)
        strMeng = strMeng & arrMeng(i) & vbTab
    Next i
   
    MsgBox strMeng

   
   
End Sub
Sub QuickSort(arr As Variant, Optional numEls As Variant, _
    Optional descending As Boolean)

    Dim value As Variant, temp As Variant
    Dim sp As Integer
    Dim leftStk(32) As Long, rightStk(32) As Long
    Dim leftNdx As Long, rightNdx As Long
    Dim i As Long, j As Long
    Dim k As Long
    Dim strPrevious As String
    Dim strCurrent As String
    Dim colTemp As Collection

    ' account for optional arguments
    If IsMissing(numEls) Then numEls = UBound(arr)
    ' init pointers
    leftNdx = LBound(arr)
    rightNdx = numEls
    ' init stack
    sp = 1
    leftStk(sp) = leftNdx
    rightStk(sp) = rightNdx

    Do
        If rightNdx > leftNdx Then
            value = arr(rightNdx)
            i = leftNdx - 1
            j = rightNdx
            ' find the pivot item
            If descending Then
                Do
                    Do: i = i + 1: Loop Until arr(i) <= value
                    Do: j = j - 1: Loop Until j = leftNdx Or arr(j) >= value
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                Loop Until j <= i
            Else
                Do
                    Do: i = i + 1: Loop Until arr(i) >= value
                    Do: j = j - 1: Loop Until j = leftNdx Or arr(j) <= value
                    temp = arr(i)
                    arr(i) = arr(j)
                    arr(j) = temp
                Loop Until j <= i
            End If
            ' swap found items
            temp = arr(j)
            arr(j) = arr(i)
            arr(i) = arr(rightNdx)
            arr(rightNdx) = temp
            ' push on the stack the pair of pointers that differ most
            sp = sp + 1
            If (i - leftNdx) > (rightNdx - i) Then
                leftStk(sp) = leftNdx
                rightStk(sp) = i - 1
                leftNdx = i + 1
            Else
                leftStk(sp) = i + 1
                rightStk(sp) = rightNdx
                rightNdx = i - 1
            End If
        Else
            ' pop a new pair of pointers off the stacks
            leftNdx = leftStk(sp)
            rightNdx = rightStk(sp)
            sp = sp - 1
            If sp = 0 Then Exit Do
        End If
    Loop
   
    Set colTemp = New Collection
    strPrevious = ""
    For k = 0 To UBound(arr)
        strCurrent = arr(k)
        If strCurrent = strPrevious Then
        Else
            colTemp.Add strCurrent
        End If
        strPrevious = strCurrent
    Next k
   
    ReDim arr(colTemp.Count)
   
    For k = 1 To colTemp.Count
        strCurrent = colTemp.Item(k)
        arr(k - 1) = strCurrent
    Next k
   
End Sub


0
 

Author Comment

by:musclejack
ID: 9925482
Can you show me the ASP version ?
0
 
LVL 6

Expert Comment

by:prasitlee
ID: 9926179
Dear musclejack,
    I am not sure if I could write this program in ASP or not. Anyway I would try to modify but it take a little bit time to change. I would tell you the progress later. If you would like to get the faster result, you might need to post this question into the Web Programming Session.
                                                     Meng
0
 
LVL 6

Expert Comment

by:prasitlee
ID: 9926278
Dear musclejack,
     Try the following link.
     http://www.planet-source-code.com/vb/scripts/ShowCode.asp?lngWId=4&txtCodeId=6495
     You might need to modify a little bit further.
     Any comment, please let me know.
                                                                       Meng
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
Article by: Martin
Here are a few simple, working, games that you can use as-is or as the basis for your own games. Tic-Tac-Toe This is one of the simplest of all games.   The game allows for a choice of who goes first and keeps track of the number of wins for…
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

911 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

17 Experts available now in Live!

Get 1:1 Help Now