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())
Related
I am looking for a simple algorithm which works on the following table:
In the first column you see the constraints. The second column should be used by the algorithm to output the iterations, which should be done like this:
0 0 0
0 0 1
........
0 0 29
0 1 0
........
0 1 29
0 2 0
0 2 1
........
........
27 9 29
28 0 0
........
........
28 9 29
Currently I have the following code:
Dim wksSourceSheet As Worksheet
Set wksSourceSheet = Worksheets("Solver")
Dim lngLastRow As Long
Dim lngLastColumn As Long
With wksSourceSheet
lngLastRow = IIf(IsEmpty(.Cells(.Rows.Count, 1)), _
.Cells(.Rows.Count, 1).End(xlUp).Row, .Rows.Count)
lngLastColumn = IIf(IsEmpty(.Cells(1, .Columns.Count)), _
.Cells(1, .Columns.Count).End(xlToLeft).Column, .Columns.Count)
Dim intRowOuter As Integer
Dim intRowInner As Integer
For intRowOuter = 2 To lngLastRow
.Cells(intRowOuter, lngLastColumn).Value = 0
Next intRowOuter
For intRowOuter = lngLastRow To 2 Step -1
For intRowInner = lngLastRow To intRowOuter Step -1
Dim constraint As Integer
Dim intConstraintCounter As Integer
intConstraint = .Cells(intRowInner, 1)
For intConstraintCounter = 1 To intConstraint
.Cells(intRowInner, lngLastColumn).Value = intConstraintCounter
Next intStampCounter
Next intRowInner
Next intRowOuter
End With
This might be a right approach but something is incorrect. I'm unfortunately stuck so I would appreciate some help on fixing this.
Solution
I would suggest using one array to store the constraints and one to represent the counter.
Dim MaxNum() As Long
Dim myCounter() As Long
ReDim MaxNum(1 To NumDigits)
ReDim myCounter(1 To NumDigits)
Next you need to initialize MaxNum. This will probably involve looping through the cells containing the constraints. Something like:
Dim constraintRange As Range
Dim i As integer
Set constraintRange = wksSourceSheet.Range("A2:A4")
For i = 1 to numDigits
MaxNum(i) = constraintRange.Cells(i,1).Value
Next i
Now we just need to write an increment counter function! The idea is pretty simple we just go from the least significant digit to the most significant. We increment the LSD and, if there is overflow we set it to 0 and then add 1 to the next digit. It looks like this:
Sub IncrNum(ByRef myNum() As Long, ByRef MaxNum() As Long)
Dim i As Integer
For i = LBound(myNum) To UBound(myNum)
myNum(i) = myNum(i) + 1
If myNum(i) > MaxNum(i) Then 'Overflow!
myNum(i) = 0 'Reset digit to 0 and continue
Else
Exit For 'No overflow so we can just exit
End If
Next i
End Sub
Which is just one for-loop! I think this will be the cleanest solution :)
NOTE: To use this function you would simply do IncrNum(myCounter, MaxNum). Which would change the value of myCounter to the next in the sequence. From here you can paste to a range by doing dstRange = myCounter.
Testing
In my own tests I used a while loop to print out all of the values. It looked something like this:
Do While Not areEqual(MaxNum, myCounter)
Call IncrNum(myCounter,MaxNum)
outRange = myCounter
Set outRange = outRange.Offset(1, 0)
Loop
areEqual is just a function which returns true if the parameters contain the same values. If you like I can provide my code otherwise I will leave it out to keep my answer as on track as it can be.
Maybe something like this can be modified to fit your needs. It simulates addition with carry:
Sub Clicker(MaxNums As Variant)
Dim A As Variant
Dim i As Long, j As Long, m As Long, n As Long
Dim sum As Long, carry As Long
Dim product As Long
m = LBound(MaxNums)
n = UBound(MaxNums)
product = 1
For i = m To n
product = product * (1 + MaxNums(i))
Next i
ReDim A(1 To product, m To n)
For j = m To n
A(1, j) = 0
Next j
For i = 2 To product
carry = 1
For j = n To m Step -1
sum = A(i - 1, j) + carry
If sum > MaxNums(j) Then
A(i, j) = 0
carry = 1
Else
A(i, j) = sum
carry = 0
End If
Next j
Next i
Range(Cells(1, 1), Cells(product, n - m + 1)).Value = A
End Sub
Used like:
Sub test()
Clicker Array(3, 2, 2)
End Sub
Which produces:
x%10 or x Mod 10 give the remainder when x is divided by 10 so you will get the last digit of x.
Since your problem is specifically asking for each digit not to exceed 463857. You can have a counter incrementing from 000000 to 463857 and only output/use the numbers the fullfill the following condition:
IF(x%10 <= 7 AND x%100 <=57 AND x%1000 <= 857 AND x%10000 <=3857 AND x%100000 <= 63857 AND x <= 463857)
THEN //perform task.
dim a(100)
a(0)=9,a(1)=3,a(2)=-3,a(3)=8,a(4)=2
how can i find size of used array(i.e used size is 5
You have to count the non-empty elements:
Option Explicit
Function UsedElms(a)
UsedElms = 0
Dim i
For i = 0 To UBound(a)
If Not IsEmpty(a(i)) Then UsedElms = UsedElms + 1
Next
End Function
Dim a(5)
a(2) = 2
a(4) = 4
WScript.Echo "ub:", UBound(a), "sz:", UBound(a) + 1, "us:", UsedElms(a)
output:
cscript 23027576.vbs
ub: 5 sz: 6 us: 2
Here's a hacky one-liner that I just thought of. It essentially counts the number of empty elements by converting them to spaces and then trimming them off.
intLastIndex = UBound(a) - Len(Join(a, " ")) + Len(Trim(Join(a, " ")))
Just for fun! Don't go putting it into your production code. It would certainly be more efficient as a two-liner:
s = Join(a, " ")
intLastIndex = UBound(a) - Len(s) + Len(Trim(s))
Ekkehard has the proper answer here, though. This hack only works if your array is filled contiguously.
I have a search box.
My admin user might search for "#MG #EB dorchester".
In ASP, I need to count how many times the symbol "#" appears in the string. How is the possible?
Try this:
len(yourString) - len(replace(yourString, "#", ""))
Response.write ubound(split(str,"#"))
is enough for counting the occurance of a specific character
For JW01
Dim pos : pos = 0
Dim count : count = -1
Do
count = count + 1
pos = InStr(pos + 1, str, "#")
Loop While (pos > 0)
Try a while loop:
Do While (str.indexOf("#") != -1)
count = count + 1
str = right(str, len(str) - str.indexOf("#"))
Loop
EDIT:
This for loop might make more sense:
dim strLen, curChar, count
count = 0
int strLen = len(str)
for i = 1 to strLen
curChar = mid(str, i, 1)
if curChar = "#"
count = count + 1
end if
next
Replace the search with blank and find the difference between and original and new string will the number of time a string is present
Dim a = "I # am # Thirs#ty"
Dim count
count = Len(a) - Len(Replace(a,"#",""))
Response.write count
Function FnMatchedStringCountFromText(strText,strStringToSearch)
strLength = Len(strText)
strNumber = 1
IntCount = 0
For i = 1 to strLength
If Instr(1,strText,strStringToSearch,0) > 0 Then
stMatch = Instr(1,strText,strStringToSearch,0)
strText = Mid(strText,stMatch+2,strLength)
IntCount = IntCount+1
Else
Exit For
End If
Next
FnMatchedStringCountFromText = IntCount
End Function
Looking for the best way to do this in VB6. Typically, I would use this approach...
' count spaces
For i = 1 To Len(text)
If Mid$(text, i, 1) = " " Then count = count + 1
Next
Not saying it's the best way, but you code do:
distinctChr = " "
count = Len(text) - Len(Replace(text, distinctChr , ""))
Use the split command like this
Dim TempS As String
TempS = " This is a split test "
Dim V As Variant
V = Split(TempS, " ")
Cls
Print UBound(V) '7
V = Split(TempS, "i")
Print UBound(V) '3
V = Split(TempS, "e")
Print UBound(V) '1
You can combine it to a single line.
Print UBound(Split(TempS, "i"))
I did some crude timing on it. On a 40,000 character string with all spaces it seems to clock in at 17 milliseconds on a 2.4 GHz Intel Core 2 processor.
A function could look like this
Function CountChar(ByVal Text As String, ByVal Char As String) As Long
Dim V As Variant
V = Split(Text, Char)
CountChar = UBound(V)
End Function
I would use a modified bucket sort:
Dim i as Integer
Dim index As Integer
Dim count as Integer
Dim FoundByAscii(0 To 255) As Boolean
For i = 1 To Len(text)
index = Asc(Mid$(text, i, 1))
FoundByAscii(index) = True
Next i
count = 0
For i = 0 To 255
If FoundByAscii(i) Then
count = count + 1
End If
Next i
...and your result is in count. The performance is O(N) - if Mid$ is O(1).
Edit:
Based on your clarification, do this:
' count spaces
Dim asciiToSearchFor As Integer
asciiToSearchFor = Asc(" ")
For i = 1 To Len(text)
If Asc(Mid$(text, i, 1)) = asciiToSearchFor Then count = count + 1
Next
As ascii compares have to be faster that string comparison. I'd profile it just in case, but I'm pretty sure.
It's not clear what you mean by the best way to do this.
If you want something very fast, but totally unmaintainable, adapt this horrible code that delves into the underlying memory of a VB6 string to count the number of words. Courtesy of VBspeed.
I want a function to calculate numerology.For example if i enter "XYZ" then my output should be 3 .
Here is how it became 3:
X = 24
Y = 25
Z = 26
on adding it becomes 75 which again adds up to 12 (7+5) which again adds up to 3(1+2) . Similarly whatever names i should pass,my output should be a single digit score.
Here you are:
Function Numerology(Str)
Dim sum, i, char
' Convert the string to upper case, so that 'X' = 'x'
Str = UCase(Str)
sum = 0
' For each character, ...
For i = 1 To Len(Str)
' Check if it's a letter and raise an exception otherwise
char = Mid(Str, i , 1)
If char < "A" Or char > "Z" Then Err.Raise 5 ' Invalid procedure call or argument
' Add the letter's index number to the sum
sum = sum + Asc(char) - 64
Next
' Calculate the result using the digital root formula (http://en.wikipedia.org/wiki/Digital_root)
Numerology = 1 + (sum - 1) Mod 9
End Function
In vbscript:
Function numerology(literal)
result = 0
for i = 1 to Len(literal)
'' // for each letter, take its ASCII value and substract 64,
'' so "A" becomes 1 and "Z" becomes 26
result = result + Asc(Mid(literal, i, 1)) - 64
next
'' // while result is bigger than 10, let's sum it's digits
while(result > 10)
partial = 0
for i = 1 to Len(CStr(result))
partial = partial + CInt(Mid(CStr(result), i, 1))
next
result = partial
wend
numerology = result
End Function
I have no idea what this could possible be used for but it was fun to write anyway.
Private Function CalcStupidNumber(ByVal s As String) As Integer
s = s.ToLower
If (s.Length = 1) Then 'End condition
Try
Return Integer.Parse(s)
Catch ex As Exception
Return 0
End Try
End If
'cover to Values
Dim x As Int32
Dim tot As Int32 = 0
For x = 0 To s.Length - 1 Step 1
Dim Val As Integer = ConvertToVal(s(x))
tot += Val
Next
Return CalcStupidNumber(tot.ToString())
End Function
Private Function ConvertToVal(ByVal c As Char) As Integer
If (Char.IsDigit(c)) Then
Return Integer.Parse(c)
End If
Return System.Convert.ToInt32(c) - 96 ' offest of a
End Function