How can I remove duplicates from an array in vbscript?
Code:
dim XObj(100),xObjXml
for s=0 to xObjXml.length-1
XObj(s)=xObjXml(s).getAttribute("xsx")
next
Please suggest a better answer for this.
Use a Dictionary to gather the unique items of the array:
>> a = Array(1, 2, 3, 1, 2, 3)
>> WScript.Echo Join(a)
>> Set d = CreateObject("Scripting.Dictionary")
>> For i = 0 To UBound(a)
>> d(a(i)) = d(a(i)) + 1
>> Next
>> WScript.Echo Join(d.Keys())
>>
1 2 3 1 2 3
1 2 3
>>
(BTW: There is no .length property for VBScript arrays)
Added:
The .Keys() method of the dictionary returns an array of the (unique) keys:
>> b = d.Keys()
>> WScript.Echo Join(b), "or:", b(2), b(1), b(0)
>>
1 2 3 or: 3 2 1
Added II: (aircode!)
Trying to get the unique attributes of the objects in an XML collection:
Dim xObjXml : Set xObjXml = ... get some collection of XML objects ...
Dim dicAttrs : Set dicAttrs = CreateObject("Scripting.Dictionary")
Dim i
For i = 0 To xObjXml.length - 1
Dim a : a = xObjXml(i).getAttribute("xsx")
dicAttrs(a) = dicAttrs(a) + 1
Next
Dim aAttrs : aAttrs = dicAttrs.Keys()
Added III (sorry!):
.Keys() is a method, so it should be called as such:
Dim aAttrs : aAttrs = dicAttrs.Keys()
Added IV:
For a working sample see here.
If you don't want a Dictionary you can use the following to compare each element in the array to itself.
Info = Array("Arup","John","Mike","John","Lisa","Arup")
x = 0
z = ubound(Info)
Do
x = x + 1
Do
z = z - 1
If x = z Then
Info(x) = Info(z)
ElseIf Info(x) = Info(z) Then
Info(x) = ""
End If
Loop Until z=0
z = ubound(Info)
Loop Until x = ubound(Info)
For each x in Info
If x <> "" Then
Unique = Unique & Chr(13) & x
End If
Next
MsgBox Unique
Related
i got a list coma separated values (a,b,c,d,e,f,g,h,....)
i wish to split them into chunks of 5 like (a,b,c,d,e) (f,g,h,i,j)....
can someone help me with the code in classic asp ?
arr = Split(messto, ",") ' convert to array
totalemails = UBound(arr) ' total number of emails
if totalemails mod 5 = 0 then
totalloops = int(totalemails/5)
else
totalloops = int(totalemails/5) + 1
end if
x = 0
y = 0
b = 0
for x = 0 to totalloops
for counter = (5* x) to ((b+5)-1)
if Trim(arr(counter)) <> "" and isnull(trim(arr(counter))) = false then
response.Write(Trim(arr(counter)))
response.Write(counter & "<br>")
mymssto = mymssto & Trim(arr(counter)) & ","
response.Write(mymssto)
end if
next
You want to use Mod() to do this it's very powerful and underutilised function.
Here is a simple example based on the code in the question;
<%
Dim mumberToGroupBy: numberToGroupBy = 5
Dim index, counter, arr, messto
messto = "a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q"
arr = Split(messto, ",") ' convert to array
For counter = 0 To UBound(arr)
'Can't divide by 0 so we need to make sure our counter is 1 based.
index = counter + 1
Call Response.Write(Trim(arr(counter)))
'Do we have any remainder in the current grouping?
If index Mod numberToGroupBy = 0 Then Response.Write("<br>")
Next
%>
Output:
abcde
fghij
klmno
pq
Useful Links
A: Change response to only respond one set of values (details the use of Mod())
I am developing a script to divide the number of files in a folder into four groups. These will be turned into four batch files but for now the issue is dividing them up as evenly as possible.
The script below will work somewhat - if I have a Count that will be divided by 4 evenly but if I have an odd number, no go and less than four will crash. You can run the script just replace the "C:\1_SourceData\Section_16\" with your own path of files. If you un-comment the section 'Add remainder to front', it was to thow any extra files, like an odd number, to the first batch but that does not quite work. The number of files in the folder will range from 1 to 25.
Any help would be most appreciated.
Option Explicit
Dim fileList : Set fileList = GetFileList("C:\1_SourceData\Section_16\")
Dim NumOfFiles : NumOfFiles = fileList.Count - 1
Dim modNumber : modNumber = NumOfFiles/4
Dim remainder : remainder = NumOfFiles Mod modNumber
Dim string1 : string1 = "batch" & batchCounter
Dim string2 : string2 = ""
'Add remainder to front
'Dim i : i = 0
'For i = NumOfFiles - remainder To NumOfFiles
' string2 = string2 & vbTab & fileList(i) & vbNewLine
'Next
Dim batchCounter : batchCounter = 1
Dim file
Dim j : j = 0
For Each file In fileList
string2 = string2 & vbTab & file & vbNewLine
j = j + 1
If j Mod modNumber = 0 Then
WScript.Echo string1 & vbNewLine & string2
batchCounter = batchCounter + 1
string1 = "batch" & batchCounter
string2 = ""
End If
Next
Public Function GetFileList(path)
Dim objFSO : Set objFSO = CreateObject("Scripting.FileSystemObject")
Dim fileList : Set fileList = CreateObject("System.Collections.ArrayList")
Dim InfFolder : Set InfFolder = objFSO.GetFolder(path)
Dim File
For Each File In objFSO.GetFolder(path).Files
fileList.Add File
Next Set GetFileList = fileList
End Function
The problem is: the .Files collection is accessible via For Each only. A 'distribution by number' (think modulo) needs an extra counter. Demo script:
Option Explicit
ReDim a(3) ' 4 groups/collections
Dim i
For i = 0 To UBound(a)
Set a(i) = CreateObject("System.Collections.ArrayList")
Next
i = 0
Dim f
' fake a list of elms accessible via For Each only
For Each f In Split("a b c d e f g h i j k l m n")
a(i Mod 4).Add f ' use Mod to determine the 'bucket'
i = i + 1 ' counter needed for Mod
Next
For i = 0 To UBound(a)
WScript.Echo i, Join(a(i).ToArray())
Next
output:
cscript 40639293.vbs
0 a e i m
1 b f j n
2 c g k
3 d h l
You could structure your loop differently.
There are F files that should be devided into B batches of X files each. Two things can happen:
F is an exact multiple of B, in which case X = F / B
F is not an exact multiple of B, in which case X = (F / B) + 1
Therefore we can write two loops that (together) count from 1 to F:
Option Explicit
Const BATCHES = 4
Const PATH = "C:\1_SourceData\Section_16"
Dim FSO : Set FSO = CreateObject("Scripting.FileSystemObject")
Dim fileList : Set fileList = GetFileList(PATH)
Dim b, i, f, x
f = fileList.Count
x = CInt(f / BATCHES)
If x * BATCHES < f Then x = x + 1
For b = 0 To BATCHES - 1
If (b * x < f) Then WScript.Echo "batch" & (b + 1)
For i = b * x To (b + 1) * x - 1
If (i < f) Then WScript.Echo vbTab & fileList(i)
Next
Next
Function GetFileList(path)
Dim file
Set GetFileList = CreateObject("System.Collections.ArrayList")
For Each file In FSO.GetFolder(path).Files
GetFileList.Add File
Next
End Function
for the next "A to Z" getting results.
for into; 5 and the number 6, I want to add.
How do I make.
for k = asc("A") to asc("Z")
response.write chr(k)
next
Result :
A
B
C
..
Z
I want
A
B
C
..
Z
5
6
Such as (
k = asc("A") to asc("Z") add "5" and add"6" )
Thank You.
You can't really have a loop for this, just add separate commands:
for k = asc("A") to asc("Z")
response.write chr(k)
next
response.write "5"
response.write "6"
Another option is storing all the ASCII numbers in array then looping that array:
Dim arrLetters(), x
ReDim arrLetters(-1)
For k=Asc("A") To Asc("Z")
ReDim Preserve arrLetters(UBound(arrLetters) + 1)
arrLetters(UBound(arrLetters)) = k
Next
ReDim Preserve arrLetters(UBound(arrLetters) + 1)
arrLetters(UBound(arrLetters)) = Asc("5")
ReDim Preserve arrLetters(UBound(arrLetters) + 1)
arrLetters(UBound(arrLetters)) = Asc("6")
For x=0 To UBound(arrLetters)
k = arrLetters(x)
response.write chr(k)
Next
Erase arrLetters
strString = "ABCDEFGHIJKLMNOPQRSTUVWXYZ56"
For i=1 To Len(strString)
Response.Write Mid(strString,i,1)
Next
Quick question that I've been struggling with. I have 2 arrays of different lengths that contain strings.
I want to output a new array which removes BOTH the elements if a duplicate is detected. At the moment it only removes duplicates but leaves the original which is incorrect for what I am trying to accomplish.
E.g.
input = array ("cat","dog","mouse","cat")
expected output = array ("dog","mouse")
actual output = array ("cat","dog","mouse")
Code is below:
Sub removeDuplicates(CombinedArray)
Dim myCol As Collection
Dim idx As Long
Set myCol = New Collection
On Error Resume Next
For idx = LBound(CombinedArray) To UBound(CombinedArray)
myCol.Add 0, CStr(CombinedArray(idx))
If Err Then
CombinedArray(idx) = Empty
dups = dups + 1
Err.Clear
ElseIf dups Then
CombinedArray(idx - dups) = CombinedArray(idx)
CombinedArray(idx) = Empty
End If
Next
For idx = LBound(CombinedArray) To UBound(CombinedArray)
Debug.Print CombinedArray(idx)
Next
removeBlanks (CombinedArray)
End Sub
Thanks for all help and support in advance.
What about using Scripting.Dictionary? Like this:
Function RemoveDuplicates(ia() As Variant)
Dim c As Object
Set c = CreateObject("Scripting.Dictionary")
Dim v As Variant
For Each v In ia
If c.Exists(v) Then
c(v) = c(v) + 1
Else
c.Add v, 1
End If
Next
Dim out() As Variant
Dim nOut As Integer
nOut = 0
For Each v In ia
If c(v) = 1 Then
ReDim Preserve out(nOut) 'you will have to increment nOut first, if you have 1-based arrays
out(nOut) = v
nOut = nOut + 1
End If
Next
RemoveDuplicates = out
End Function
Here is a quick example. Let me know if you get any errors.
Sub Sample()
Dim inputAr(5) As String, outputAr() As String, temp As String
Dim n As Long, i As Long
inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"
BubbleSort inputAr
For i = 1 To UBound(inputAr)
If inputAr(i) = inputAr(i - 1) Or inputAr(i) = temp Then
inputAr(i - 1) = "": temp = inputAr(i): inputAr(i) = ""
End If
Next i
n = 0
For i = 1 To UBound(inputAr)
If inputAr(i) <> "" Then
n = n + 1
ReDim Preserve outputAr(n)
outputAr(n) = inputAr(i)
End If
Next i
For i = 1 To UBound(outputAr)
Debug.Print outputAr(i)
Next i
End Sub
Sub BubbleSort(arr)
Dim value As Variant
Dim i As Long, a As Long, b As Long, c As Long
a = LBound(arr): b = UBound(arr)
Do
c = b - 1
b = 0
For i = a To c
value = arr(i)
If (value > arr(i + 1)) Xor False Then
arr(i) = arr(i + 1)
arr(i + 1) = value
b = i
End If
Next
Loop While b
End Sub
EDIT
Another way without sorting
Sub Sample()
Dim inputAr(5) As String, outputAr() As String
Dim n As Long, i As Long, j As Long
Dim RemOrg As Boolean
inputAr(0) = "cat": inputAr(1) = "Hen": inputAr(2) = "mouse"
inputAr(3) = "cat": inputAr(4) = "dog": inputAr(5) = "Hen"
For i = 0 To UBound(inputAr)
For j = 1 To UBound(inputAr)
If inputAr(i) = inputAr(j) Then
If i <> j Then
inputAr(j) = "": RemOrg = True
End If
End If
Next
If RemOrg = True Then
inputAr(i) = ""
RemOrg = False
End If
Next i
n = 0
For i = 0 To UBound(inputAr)
If inputAr(i) <> "" Then
n = n + 1
ReDim Preserve outputAr(n)
outputAr(n) = inputAr(i)
End If
Next i
For i = 1 To UBound(outputAr)
Debug.Print outputAr(i)
Next i
End Sub
I need to create multi-dimensional array of strings. Each row of the array can have varying number of strings. Something like the follwing code:
twoDimension = Array(Array())
ReDim Preserve twoDimension(3)
For i = 0 to 2
If i = 1 Then
twoDimension(i) = Array(1,2,3)
End If
If i = 2Then
twoDimension(i) = Array(1,2,3,4,5)
End If
Next
How about a dictionary
Set a = CreateObject("Scripting.Dictionary")
a.Add 0, Array(1,2,3)
a.Add 1, Array(4,5,6)
MsgBox a.Count
MsgBox a.Item(0)(2)
MsgBox a.Item(1)(1)
There's nothing wrong with having jagged arrays in VBScript. There are some minor issues with your code (ReDim to 3 but only assigning values to 2, unnecessarily using a For loop to assign values), but in general, that's the correct syntax to use.
Option Explicit
Dim twoDimension, i, j
twoDimension = Array(Array())
ReDim Preserve twoDimension(2)
twoDimension(1) = Array(1,2,3)
twoDimension(2) = Array(1,2,3,4,5)
For i = 0 To UBound(twoDimension)
For j = 0 To UBound(twoDimension(i))
WScript.Echo "(" & i & "," & j & ") = " & twoDimension(i)(j)
Next
Next