I trying to create an empty/defined array of Double which would reflect as Double(0, -1).
I'm able to create one for an array of String, Variant and Byte:
Dim arr_variant() As Variant
arr_variant = Array() ' Variant(0 to -1) '
Dim arr_string() As String
arr_string = Split(Empty) ' String(0 to -1) '
Dim arr_byte() As Byte
arr_byte = "" ' Byte(0 to -1) '
Dim arr_double() As Double
arr_double = ??? ' Double(0 to -1) '
, but still haven't found a way for Double.
Maybe with LSet or with a native function?
It seems that the only way is to call a native function:
Private Declare PtrSafe Function SafeArrayRedim Lib "OleAut32" ( _
ByVal arr As LongPtr, ByRef dims As Any) As Long
Public Sub RedimDouble(arr() As Double, ByVal count As Long)
If count Then
ReDim Preserve arr(0 To count - 1)
Else
ReDim arr(0 To 0)
SafeArrayRedim Not Not arr, 0#
End If
End Sub
Public Sub Usage()
Dim arr_double() As Double
RedimDouble arr_double, 0 ' Double(0 to -1) '
End Sub
I would go with - not possible.
Take a look at the following code:
Option Explicit
Sub TestMe()
Dim arr 'Line 1
arr = Array(CDbl(0)) 'Line 2
arr = Array(Empty) 'Line 3
End Sub
Line 1 - It takes a Variant array
Line 2 - Makes it Double array
Line 3 - When emptied, it is converted from double to Variant again.
Related
This is the program I need to re-write and I dont understand.
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
Call DisplayArray(array)
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
I need it to
be a function
with two parameters, an array and constant k
should return an array where each elemtn of the array is equal to k ^ i
Well I can't really say I completely understand what you're doing. And I suspect this might be a homework question I'm giving the answers too against my better judgement. It's really not that complicated and likely something you could of done yourself with the appropriate research.
And calling a function for this does seem complete overkill as can be done quite simply when outputting your array in the DisplayArray method
Sub Main()
Dim array(24) As Double, i As Long
array(0) = 1
For i = 1 To 24
array(i) = 2 * array(i - 1)
Next i
'Calling the function here with the constant 3
Dim results() As Double = CalculateResults(array, 3)
Call DisplayArray(array)
Call DisplayArray(results)
Console.ReadLine()
End Sub
Sub DisplayArray(ByVal array() As Double)
Dim i As Long, n As Long
n = array.GetLength(0)
For i = 0 To n - 1
Console.WriteLine(array(i))
Next i
End Sub
Function CalculateResults(ByVal array As Double(), ByVal k As Integer) As Double()
Dim retVal(array.Length) As Double
For index = 0 To array.Length
retVal(index) = index ^ k
Next
Return retVal
End Function
I have tried everything related to this ByRef error, other programmers mentioned that I have to set the value type of each variable I create, other said to remove the type of those variables.
I truly need some help since it is my first day with VB.
The Main Idea Of the Code Below is to make a small form that after clicking, the line on the word document will scroll down or up smoothly, and of course he has the capability of increase/decrease the speed of this movement.
Here is the Main Functions:
Function GoDown(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
CounterUp = 0
CounterDown = 1
Dim NumberOfPages As Integer
Set NumberOfPages = ActiveDocument.ComputeStatistics(wdStatisticPages)
Dim NumberOfLines As Range
Set NumberOfLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)
Dim Multiplicate As Integer
Set Multiplicate = NumberOfPages * NumberOfLines
Dim Counter As Integer
Set Counter = 0
While (Counter < Multiplicate):
ActiveWindow.SmallScroll down:=1
Counter = Counter + 1
Call Application.Wait(Now + TimeValue("0:00:'&Speed&'"))
Call ActiveWindow.Close
Call Application.Quit
End Function
Function GoUp(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Dim NumberOfLines As Range
Set NumberOfLines = ActiveDocument.BuiltInDocumentProperties(wdPropertyLines)
Set CounterUp = 1
Set CounterDown = 0
Dim Counter As Integer
Set Counter = 0
While (Counter < NumberOfLines):
ActiveWindow.SmallScroll up:=1
Counter = Counter + 1
Call Application.Wait(Now + TimeValue("0:00:'&Speed&'"))
End Function
Function GoFaster(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Speed = Speed - 1
If (CounterUp > 0 & CounterDown = 0) Then
Call Application.Run("btnUp_Click")
Else: Call Application.Run("btnDown_Click")
End Function
Function GoSlower(ByRef Speed As Integer, ByRef CounterUp As Integer, ByRef CounterDown As Integer)
Speed = Speed + 1
If (CounterDown > 0 & CounterUp = 0) Then Call Application.Run("btnDown_Click")
Else: If (CounterDown = 0 & CounterUp > 0) Then Call Application.Run("btnUp_Click")
End Function
I have tried Instead of Function to put Sub, nothing happened. I also have tried the "cint" and did not succeeded.
Here is the implementation on click events:
Sub Main()
Dim Speed As Integer
Set Speed = 3
Dim CounterUp As Integer
Set CounterUp = 0
Dim CounterDown As Integer
Set CounterDown = 0
Public Sub btnDown_Click_Click()
Call GoDown(Speed as Integer, CounterUp as Integer, CounterDown)
End Sub
Public Sub btnLeft_Click_Click()
Call GoSlower(Speed, CounterUp, CounterDown)
End Sub
Public Sub btnRight_Click_Click()
Call GoFaster(Speed, CounterUp, CounterDown)
End Sub
Public Sub btnUp_Click_Click()
Call GoUp(Speed, CounterUp, CounterDown)
End Sub
End Sub
as You see that I have tried two methods have been mentioned in MSDN and here, but none has solved my "ByRef argument type mismatch".
You can call a sub like this:
GoDown Speed, CounterUp, CounterDown
or use a function:
x = GoDown(Speed, CounterUp, CounterDown)
In attached example there are subs nested in main sub. It can't work like this, any procedure triggered by clicking will need to be separated.
Instead of Integer, always use Long or you will be encountering problems with data exceeding limitation of Integer (maximum value of 32767 and minimum of -32768).
Thank you all for who tried to help me to solve my problem , and for the unpaid philosopher .
Any way .
Any time you need to use a variable for multiple events or multiple functions .
you have to :
`Public ThisVariable As String`
in the load event of the form like this :
FormName_Initialize()
{
ThisVariable = "The Starting value you want :)"
}
Thank you
I have found this VBA script (running in powerpoint) and I just wanted to know how to stop numbers from being repeated. I did some google searches and I think the solution would be to create an array, and have the selected number go into the array. The script would then generate a new number as long as it skips all numbers in the array.
I'm just not sure how to implement this as I do not know VBA.
here is the script:
Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Dim chosenNum As Integer
Dim I As Integer
Dim k As Integer
Sub randomNumber()
lowRand = 1
maxRand = 10
Randomize
For k = 1 To 10
chosenNum = Int((maxRand - lowRand) * Rnd) + lowRand
With ActivePresentation.SlideShowWindow.View.Slide.Shapes(2).TextFrame.TextRange
.Text = chosenNum
End With
For I = 1 To 1
Sleep (50)
DoEvents
Next
Next
End Sub
Any thoughts? Thanks.
This will collect 10 unique single digit numbers (0 to 9) into a string and then split them into an array. As each is returned to the slide, 1 is added so the resut is 1 to 10.
Sub randomNumber()
Dim lowRand As Long, maxRand As Long, strNum As String, chosenNum As String
Dim k As Long, vNUMs As Variant
lowRand = 0: maxRand = 10: strNum = vbNullString
Randomize
For k = 1 To 10
chosenNum = Format(Int((maxRand - lowRand) * Rnd) + lowRand, "0")
Do While CBool(InStr(strNum, chosenNum))
chosenNum = Format(Int((maxRand - lowRand) * Rnd) + lowRand, "0")
Loop
strNum = strNum & chosenNum
Next k
vNUMs = Split(StrConv(strNum, vbUnicode), Chr(0))
For k = LBound(vNUMs) To UBound(vNUMs)
With ActivePresentation.SlideShowWindow.View.Slide.Shapes(2).TextFrame.TextRange
.Text = vNUMs(k) + 1
End With
For I = 1 To 1
Sleep (50)
DoEvents
Next
Next k
End Sub
I just wrote this to help you. The function is designed to return random integer numbers in the range you specify until all numbers in the range have been returned when it will then return -1. There is a test sub included to show how to use the function to get all numbers from 5 to 10.
'----------------------------------------------------------------------------------
' Copyright (c) 2015 YOUpresent Ltd.
' Source code is provide under Creative Commons Attribution License
' This means you must give credit for our original creation in the following form:
' "Includes code created by YOUpresent Ltd. (YOUpresent.co.uk)"
' Commons Deed # http://creativecommons.org/licenses/by/3.0/
' License Legal # http://creativecommons.org/licenses/by/3.0/legalcode
'----------------------------------------------------------------------------------
Option Explicit
Option Base 0 ' Explicitly set the lower bound of arrays to 0
Private iUsed As Integer ' count of all used numebrs
Public arrTracking() As String
'----------------------------------------------------------------------------------
' Purpose: Returns a random number in a specified range without repeats
' Inputs: iLow - integer representing the low end of the range
' iHigh - integer representing the high end of the range
' bReset - boolean flag to optionally reset the array
' Outputs: returns an integer number or -1 if all numbers have been used
' Example first call: myNum = GetRandomNumber(10, 5, true)
' Example subsequent call: myNum = GetRandomNumber(10, 5)
'----------------------------------------------------------------------------------
Function GetRandomNumber(iLow As Integer, iHigh As Integer, Optional bReset As Boolean) As Integer
Dim iNum As Integer ' random number to be generated
Dim InArray As Boolean ' flag to test if number already used
Randomize
' Reset the tracking array as required
If bReset Then ReDim arrTracking(iHigh - iLow)
' If we've used all of the numbers, return -1 and quit
If iUsed = iHigh - iLow + 1 Then
GetRandomNumber = -1
Exit Function
End If
' Repeat the random function until we find an unused number and then
' update the tracking array, uncrease the counter and return the number
Do While Not InArray
iNum = Fix(((iHigh - iLow + 1) * Rnd + iLow))
If arrTracking(iNum - iLow) = "" Then
arrTracking(iNum - iLow) = "used"
iUsed = iUsed + 1
InArray = True
GetRandomNumber = iNum
Else
'Debug.Print iNum & " used"
End If
Loop
End Function
'----------------------------------------------------------------------------------
' Purpose: Test sub to get all random numbers in the range 5 to 10
' Inputs: None
' Outputs: Debug output of 6 numbers in the range 5 to 10 in then immediate window
'----------------------------------------------------------------------------------
Sub GetAllRand()
Dim iRndNum As Integer
' Get the initial number, restting the tracking array in the process
iRndNum = GetRandomNumber(5, 10, True)
Debug.Print iRndNum
Do While Not iRndNum = -1
iRndNum = GetRandomNumber(5, 10)
Debug.Print iRndNum
Loop
End Sub
Here's a UDF that you can use to populate an array with unique random numbers:
Function GetRandomDigits(amount As Integer, maxNumber As Integer) As Variant
With CreateObject("System.Collections.ArrayList")
Do
j = WorksheetFunction.RandBetween(1, maxNumber)
If Not .Contains(j) Then .Add j
Loop Until .Count = amount
GetRandomDigits = .ToArray()
End With
End Function
And here's an example of how to use it:
Sub MM()
Dim nums As Variant
nums = GetRandomDigits(10, 100)
For Each num In nums
Debug.Print num
Next
End Sub
If my function looks like
function(optional byval string1 as String,optional byval string2 as String,optional byval string3 as String )
And I only want to call the function by supplying string3 by entering "=function(string3)" in cell, how can I do that ?
It's possible in one of two ways...
Call the routine and identify which optional parameter is being used by "skipping" unusued parms:
Function MyFunc(optional a as integer, _
optional b as integer, _
optional c as integer) as double
MyFunc = c * 3.14159
End Function
=MyFunc(,,12) <== called as UDF on worksheet or in VBA module
Code your function with an argument list:
Function MyFunc(args() As Variant) As Double
Dim numberOfArgs As Integer
Dim arg As Variant
Dim i As Integer
Dim answer As Double
numberOfArgs = UBound(args)
i = 1
For Each arg In args
Debug.Print "arg(" & i & ") = " & arg
answer = Int(arg) * 3.14159
i = i + 1
Next arg
MyFunc = answer
End Function
Sub test1()
Dim parms() As Variant
ReDim parms(1 To 3)
'parms(1) = ??
'parms(2) = ??
parms(3) = 21
Debug.Print MyFunc(parms)
End Sub
How can I write all possible combinations to the console? For example, if user enters abc, then it will write aaa, aab, aac, abb, abc, acc, bbb, bbc, ccc. Please help me.
Here's some code:
Dim abc() As String = {"a", "b", "c"} '
Sub Main()
Console.WriteLine("Enter the amount of characters")
Dim count As Integer = Console.ReadLine
outputStrings("", count)
Console.ReadLine()
End Sub
Private Sub outputStrings(ByVal startString As String, ByVal letterCount As Integer)
For i = 0 To abc.Length - 1
Dim temp As String = startString
temp += abc(i)
If temp.Length = letterCount Then
Console.WriteLine(temp)
If i = abc.Length - 1 Then
Console.WriteLine("----")
End If
Else
outputStrings(temp, letterCount)
End If
Next
End Sub
Something has to be done after the dashed lines to remove unwanted permutation to leave out only valid combinations.
You can restrict the letters used to ones at or to the right of abc(i) with an additional parameter abcIndex, and start the for loop from there. Only strings which have their letters in alphabetical order will be written, which prevents duplicates.
Private Sub outputStrings(ByVal startString As String, ByVal letterCount As Integer, ByVal abcIndex As Integer)
For i = abcIndex To abc.Length - 1
Dim temp As String = startString
temp += abc(i)
If temp.Length = letterCount Then
Console.WriteLine(temp)
Else
outputStrings(temp, letterCount, i)
End If
Next
End Sub
Call with:
outputStrings("", 3, 0)
def go(chars,thusfar):
if len(thusfar) = len(chars):
print thusfar
for char in chars:
go(chars,thusfar+char);
This should be easy enough to translate to VB (read: I don't know VB)
You just need to make a recursive call there.
Dim abc() As String = {"a", "b", "c"} '
Sub Main()
Console.WriteLine("Enter the amount of characters")
Dim count As Integer = Console.ReadLine
outputStrings("", count)
Console.ReadLine()
End Sub
Private Sub outputStrings(ByVal startString As String, ByVal letterCount As Integer)
For i = 0 To abc.Count - 1
Dim temp As String = startString
temp += abc(i)
If temp.Length = letterCount Then
Console.WriteLine(temp)
Else
outputStrings(temp, letterCount)
End If
Next
End Sub
Do note that if someone enters a negative number that your code will run forever. I'll leave fixing that as an easy exercise.
Amazing code from here:
Private Shared Function PermutationsWithRepetition(Of T)(list As IEnumerable(Of T), length As Integer) As IEnumerable(Of IEnumerable(Of T))
If length = 1 Then
Return list.[Select](Function(x) New T() {x})
End If
Return PermutationsWithRepetition(list, length - 1).SelectMany(Function(x) list, Function(t1, t2) t1.Concat(New T() {t2}))
End Function
Can be used with Integer, Char, Double etc.
Example of use:
Dim myarray(1) As Integer
myarray(0) = 1
myarray(1) = 2
Dim k As Integer = 2 'number of "slots" to do the permutations
mypermutations = PermutationsWithRepetition(myarray,k)
For Each row As IEnumerable(Of Integer) In mypermutations
Console.WriteLine("")
For Each col As IntegerIn row
Console.Write(col.toString())
Next
Next
Output:
11
12
21
22