Results 1 to 6 of 6
  1. #1
    Lounger
    Join Date
    Oct 2007
    Location
    Wirral, UK
    Posts
    39
    Thanks
    0
    Thanked 0 Times in 0 Posts
    I have written a little VBScript that lists factors for a range of whole numbers. User keys a:b and the script lists the factors of a thru b and presents them on Notepad. e.g. if user keys 10747:10749, this will be returned:

    ***NOTE: the hyphens are spaces in real life - forum edits them out! ***

    10747 : ----1 ---11 --977 10747
    10748 : ----1 ----2 ----4 -2687 -5374 10748
    10749 : ----1 ----3 -3583 10749

    This is the code:

    dim OutFile, gotline, number, oneshort, leftover, _
    factors, howmany, factorrange, lowernum, uppernum, position, i

    if FileExists("C:\FactorRange.txt") then
    FileDelete("C:\FactorRange.txt")
    end if

    Call OpenForWriting("C:\FactorRange.txt")

    factorrange = inputbox("generate factors between a:b; key numbers with colon")
    position = instr(factorrange, ":")
    lowernum = trim(left(factorrange, position - 1)) + 0
    uppernum = trim(mid(factorrange, position + 1, len(factorrange) - position)) + 0
    for number = lowernum to uppernum
    oneshort = number - 1
    for i = 2 to oneshort
    leftover = number mod i
    if leftover = 0 then
    Call Paddednum(i)
    factors = factors & " " & Paddednum(i)
    howmany = howmany + 1
    end if
    next
    gotline = Paddednum(number) & " : " & Paddednum("1") &_
    factors & " " & Paddednum(number)
    outfile.writeline(gotline)
    factors = ""
    next
    OutFile.Close
    Call Runprogram("notepad c:/FactorRange.txt", False)
    Function FileExists(filename)
    dim FileObject2
    Set FileObject2 = CreateObject("Scripting.FileSystemObject")
    FileExists = FileObject2.FileExists(filename)
    End Function
    Function Paddednum (i)
    select Case len(i)
    Case 1
    Paddednum = " " & i
    Case 2
    Paddednum = " " & i
    Case 3
    Paddednum = " " & i
    Case 4
    Paddednum = " " & i
    Case Else
    Paddednum = i
    End Select
    End Function
    Sub FileDelete(filename)
    dim FileObject
    Set FileObject = CreateObject("Scripting.FileSystemObject")
    FileObject.DeleteFile(filename)
    End Sub

    Sub OpenForWriting(filename)
    Const ForReading = 1, ForWriting = 2, ForAppending = 8
    Dim FileObject4
    Set FileObject4 = CreateObject("Scripting.FileSystemObject")
    Set OutFile = FileObject4.OpenTextFile(filename, ForWriting, True)
    End Sub

    Sub RunProgram(filename, Wait)
    Set WshShell = WScript.CreateObject("WScript.Shell")
    RetVal = WshShell.Run(filename, 1, Wait)
    End Sub


    The code works, but the bit that makes me wince every time I look at it is the Function Paddednum:

    *** as above: the hyphens are spaces in the real code ***

    Function Paddednum (i)
    select Case len(i)
    Case 1
    Paddednum = "----" & i
    Case 2
    Paddednum = "---" & i
    Case 3
    Paddednum = "--" & i
    Case 4
    Paddednum = "-" & i
    Case Else
    Paddednum = i
    End Select
    End Function


    This function pads out the numbers with trailing spaces so that factors will always appear in neat columns on the report. In the example above the largest factor is 5 characters so everything is padded out to width 5. The problem is, if I am running the script for (say) 90:140, the largest factor is now 3 characters, so if I want to avoid superfluous spaces I have to edit Paddednum; in this case by removing Case 3 and Case 4 and subtracting 2 spaces from the " " in Case 1 and Case 2.

    Is there a way of automating this? The edit length will always be the length of b in 'a:b'

    Feel free to make any other comments on the VBScript!

  2. #2
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post
    Does this do the job?

    [codebox]Function Paddednum (i)

    strVal=""

    for pad= 4 to len(i) step -1

    strVal = " " & strVal

    next

    Paddednum = strVal & i

    End Function[/codebox]
    Jerry

  3. #3
    Lounger
    Join Date
    Oct 2007
    Location
    Wirral, UK
    Posts
    39
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Jezza, it's better than my function but I'll still need to edit the hard coded '4' according to the length of b in the a:b input. Possibly I could put the length of b in another field and pass this as a second parameter to the function.

  4. #4
    Platinum Lounger
    Join Date
    Feb 2002
    Location
    A Magic Forest in Deepest, Darkest Kent
    Posts
    5,681
    Thanks
    0
    Thanked 1 Time in 1 Post
    OK try this:

    [codebox]Function Paddednum (i)

    strVal=""

    for pad= len(uppernum)+1 to len(i) step -1

    strVal = " " & strVal

    next

    Paddednum = strVal & i

    End Function[/codebox]

    Also to tidy the output change line 24 to

    gotline = number & " : " & Paddednum("1") &_
    Jerry

  5. #5
    Super Moderator jscher2000's Avatar
    Join Date
    Feb 2001
    Location
    Silicon Valley, USA
    Posts
    23,112
    Thanks
    5
    Thanked 93 Times in 89 Posts
    [quote name='Treecreeper' post='773972' date='06-May-2009 12:48']
    Code:
    Function Paddednum (i)
       select Case len(i)
    	  Case 1
    		 Paddednum = "----" & i
    	  Case 2
    		 Paddednum = "---" & i
    	  Case 3
    		 Paddednum = "--" & i
    	  Case 4
    		 Paddednum = "-" & i
    	  Case Else
    		 Paddednum = i
       End Select
    End Function
    [/quote]
    I generally do it this way, although you could make the size dynamic by replacing 5 with your maxlength, whatever it is:
    Code:
    strPadded = Right(Space(5) & i, 5)

  6. #6
    Lounger
    Join Date
    Oct 2007
    Location
    Wirral, UK
    Posts
    39
    Thanks
    0
    Thanked 0 Times in 0 Posts
    Thanks for these answers, Jezza and jscher. I've tried both of them out and they both work fine, although I had to make two adjustments to yours, Jezza;
    i) Where you have 'len(uppernum) + 1' I found I needed 'len(uppernum) - 1'
    ii) Uppernum was required as a second parameter.
    Also, I didn't make your change to line 24 as I think that would left justify the lines and so spoil the column alignment if a and b in the a:b input were different lengths.

    I now have two VBScripts with the two methods. If I get an idle moment I will run a speed competition to see which is the most efficient. But I won't post the result as that would be ungrateful to one of you, unless it was a draw!

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •