CODEWITHSUNDEEP
arrayssortingdatevbscript
demetrius henning
demetrius henning

Reputation: 23

i need help sorting a array dynamically on column bases on the date match from string

the array

myarray(uid,3/1/2016,3/4/2016,3/5/2016,3/6/2016,3/7/2016,3/8/2016
1,8,6,3,5,3,2
2,3,7,2,3,9,4
3,6,7,1,1,1,7
4,1,5,2,4,7,4
5,9,9,9,7,4,3
6,5,4,2,9,6,4
7,5,1,5,2,6,8
8,7,1,7,9,3,4
9,4,2,7,8,4,9
10,1,1,2,9,8,4)

the sample code im trying to work with 

dim datearray
datearray(0) = "3/1/2016"
datearray(1) = "3/2/2016"
datearray(2) = "3/3/2016"
for var = lbound(datearray) to ubound(datearray)

needed code here
next

so im looking to match a date from array then sort on the column

Upvotes: 2

Views: 60

Answers (2)

Hackoo
Hackoo

Reputation: 18847

You should use a RegExp to get the portion of the string that appears to be the date and use the IsDate function to validate it.

Option Explicit
Dim myarray,i,MyDate
myArray=Array("3/1/2016","3/4/2016","3/5/2016","3/6/2016","3/7/2016","3/8/2016",_
"1","8","6","3","5","3","2",_
"2","3","7","2","3","9","4",_
"3","6","7","1","1","1","7",_
"4","1","5","2","4","7","4",_
"5","9","9","9","7","4","3",_
"6","5","4","2","9","6","4",_
"7","5","1","5","2","6","8",_
"8","7","1","7","9","3","4",_
"9","4","2","7","8","4","9",_
"10","1","1","2","9","8","4")
'Before sorting the array
WScript.Echo "Before sorting the array " & VbCrLF & VbCrLF & Join( myArray, vbTab )
Sort myarray 'Sort the array
'After sorting the array
WScript.Echo "After sorting the array " & VbCrLF & VbCrLF & Join( myArray, vbTab )

For i=LBound(myArray) to UBound(myArray)
    If FormatOutput(myArray(i)) <> "" Then
        MyDate = Mydate & FormatOutput(myArray(i)) & VbCrLF
    End If  
Next
wscript.echo MyDate
'*********************************************
Function FormatOutput(s)
    Dim re, match
    Set re = New RegExp
    re.Pattern = "[\d]+[\/-][\d]+[\/-][\d]+"
    re.Global = True
    For Each match In re.Execute(s)
        if IsDate(match.value) then
            FormatOutput = CDate(match.value)
            Exit For
        end if
    Next
    Set re = Nothing
End Function
'*********************************************
Sub Sort( ByRef myArray )
    Dim i, j, strHolder
    For i = ( UBound( myArray ) - 1 ) to 0 Step -1
        For j= 0 to i
            If UCase( myArray( j ) ) > UCase( myArray( j + 1 ) ) Then
                strHolder        = myArray( j + 1 )
                myArray( j + 1 ) = myArray( j )
                myArray( j )     = strHolder
            End If
        Next
    Next 
End Sub
'*********************************************

Upvotes: 1

user6017774
user6017774

Reputation:

Recordsets can be filtered better than arrays and can sort themselves unlike arrays. This reads from standard in and writes to standard out. They can also save themselves to disk.

It creates a recordset in memory with two fields - a sortkey and a line of text.

It then loops through input and writes the sortkey extracted from the lines of text and the line into the recordset. Sets sort column. Loops through again writing the sorted recordset to standard out.

This differes from most use of a recordset as we create a disconnected one in memory rather than from a query on a database.

See https://msdn.microsoft.com/en-us/library/ms681510(v=vs.85).aspx

Set rs = CreateObject("ADODB.Recordset")
With rs
    .Fields.Append "SortKey", 4 
    .Fields.Append "Txt", 201, 5000 
    .Open
    Do Until Inp.AtEndOfStream
        Lne = Inp.readline
        SortKey = Mid(Lne, LCase(Arg(3)), LCase(Arg(4)) - LCase(Arg(3)))
        If IsNumeric(Sortkey) = False then
            Set RE = new Regexp
            re.Pattern = "[^0-9\.,]"
            re.global = true
            re.ignorecase = true
            Sortkey = re.replace(Sortkey, "")
        End If
        If IsNumeric(Sortkey) = False then
            Sortkey = 0
        ElseIf Sortkey = "" then
            Sortkey = 0
        ElseIf IsNull(Sortkey) = true then
            Sortkey = 0
        End If
        .AddNew
        .Fields("SortKey").value = CSng(SortKey)
        .Fields("Txt").value = Lne
        .UpDate
    Loop
    If LCase(Arg(2)) = "a" then SortColumn = "SortKey ASC"
    If LCase(Arg(2)) = "d" then SortColumn = "SortKey DESC"
    .Sort = SortColumn
    Do While not .EOF
        Outp.writeline .Fields("Txt").Value
        .MoveNext
    Loop
End With

Upvotes: 1

Related Questions