I was playing around with recursive and create this.
ABBB runs OK, get true
BABB runs OK, get true
BBAB runs OK, get true
BBBA does not run properly, get false
This part of the function runs properly, but when exit function is called the line jumps to the last end if line of the code. When I f8 through the code it jumps back and forth three times. It is almost as if it is compiling x3 the if loop instead of exiting the function.
OK this works. Thank you all.
Function practieRecursive(userstring, UserStringIndex) As Boolean
UserStringIndex = UserStringIndex + 1
If CInt(UserStringIndex) > Len(userstring) Then
practieRecursive = False
Exit Function
ElseIf Mid(userstring, UserStringIndex, 1) = "A" Then
practieRecursive = True
Debug.Print practieRecursive
Exit Function
Else
practieRecursive = practieRecursive(userstring, UserStringIndex)
Exit Function
End If
Debug.Print practieRecursive
End Function
You're attempting Mid(userstring, UserStringIndex, 1) = "A" before checking CInt(UserStringIndex) = Len(userstring). Reorder your checks.
Function practieRecursive(userstring, UserStringIndex) As Boolean
UserStringIndex = UserStringIndex + 1
If CInt(UserStringIndex) = Len(userstring) Then
practieRecursive = False
Exit Function
elseIf Mid(userstring, UserStringIndex, 1) = "A" Then
Stop
practieRecursive = True
Exit Function
Else
Call practieRecursive(userstring, UserStringIndex)
End If
End Function
Related
I need to remove the numeric part at the end of a string. Here are some examples:
"abcd1234" -> "abcd"
"a3bc45" -> "a3bc"
"kj3ih5" -> "kj3ih"
You get the idea.
I implemented a function which works well for this purpose.
Function VarStamm(name As String) As String
Dim i, a As Integer
a = 0
For i = Len(name) To 1 Step -1
If IsNumeric(Mid(name, i, 1)) = False Then
i = i + 1
Exit For
End If
Next i
If i <= Len(name) Then
VarStamm = name.Substring(0, i - 1)
Else
VarStamm = name
End If
End Function
The question is: is there any faster (more efficient in speed) way to do this? The problem is, I call this function within a loop with 3 million iterations and it would be nice to have it be more efficient.
I know about the String.LastIndexOf method, but I don't know how to use it when I need the index of the last connected number within a string.
You can use Array.FindLastIndex and then Substring:
Dim lastNonDigitIndex = Array.FindLastIndex(text.ToCharArray(), Function(c) Not char.IsDigit(c))
If lastNonDigitIndex >= 0
lastNonDigitIndex += 1
Dim part1 = text.Substring(0, lastNonDigitIndex)
Dim part2 = text.Substring(lastNonDigitIndex)
End If
I was skeptical that the Array.FindLastIndex method was actually faster, so I tested it myself. I borrowed the testing code posted by Amessihel, but added a third method:
Function VarStamm3(name As String) As String
Dim i As Integer
For i = name.Length - 1 To 0 Step -1
If Not Char.IsDigit(name(i)) Then
Exit For
End If
Next i
Return name.Substring(0, i + 1)
End Function
It uses your original algorithm, but just swaps out the old VB6-style string methods for newer .NET equivalent ones. Here's the results on my machine:
RunTime :
- VarStamm : 00:00:07.92
- VarStamm2 : 00:00:00.60
- VarStamm3 : 00:00:00.23
As you can see, your original algorithm was already quite well tuned. The problem wasn't the loop. The problem was Mid, IsNumeric, and Len. Since Tim's method didn't use those, it was much faster. But, if you stick with a manual for loop, it's twice as fast as using Array.FindLastIndex, all things being equal
Given your function VarStamm and Tim Schmelter's one named VarStamm2, here is a small test performance I wrote. I typed an arbitrary long String with a huge right part, and ran the functions one million times.
Module StackOverlow
Sub Main()
Dim testStr = "azekzoerjezoriezltjreoitueriou7657678678797897898997897978897898797989797"
Console.WriteLine("RunTime :" + vbNewLine +
" - VarStamm : " + getTimeSpent(AddressOf VarStamm, testStr) + vbNewLine +
" - VarStamm2 : " + getTimeSpent(AddressOf VarStamm2, testStr))
End Sub
Function getTimeSpent(f As Action(Of String), str As String) As String
Dim sw As Stopwatch = New Stopwatch()
Dim ts As TimeSpan
sw.Start()
For i = 1 To 1000000
f(str)
Next
sw.Stop()
ts = sw.Elapsed
Return String.Format("{0:00}:{1:00}:{2:00}.{3:00}",
ts.Hours, ts.Minutes, ts.Seconds,
ts.Milliseconds / 10)
End Function
Function VarStamm(name As String) As String
Dim i, a As Integer
a = 0
For i = Len(name) To 1 Step -1
If IsNumeric(Mid(name, i, 1)) = False Then
i = i + 1
Exit For
End If
Next i
If i <= Len(name) Then
VarStamm = name.Substring(0, i - 1)
Else
VarStamm = name
End If
End Function
Function VarStamm2(name As String) As String
Dim lastNonDigitIndex = Array.FindLastIndex(name.ToCharArray(), Function(c) Not Char.IsDigit(c))
If lastNonDigitIndex >= 0 Then
lastNonDigitIndex += 1
Return name.Substring(0, lastNonDigitIndex)
End If
Return name
End Function
End Module
Here is the output I got:
RunTime :
- VarStamm : 00:00:38.33
- VarStamm2 : 00:00:02.72
So yes, you should choose his answer, his code is both pretty and efficient.
In below code when I jump to the line
Range("Asset_Repline_num").value = Range("repline_start").value - 1 + CA,
it keeps taking me to another function in another code module. If I comment the other function out it works fine. What am i doing wrong here? Also Range("repline_start").value = value keeps becoming "value" and not "Value". Is there anything wrong here?
Sub sumsingleassetr()
TotalPeriod = 100
Application.Calculation = xlCalculationAutomatic
ReDim rngscheduled_bal(1 To TotalPeriod, 0)
CA_Rep = Range("repline_end").value - Range("repline_start").value + 1
TotalRepline = CA_Rep
CA = 0
For i = 1 To CA_Rep
CA = CA + 1
If CA <= CA_Rep Then
Range("Asset_Repline_num").value = Range("repline_start").value - 1 + CA
End If
Next i
End Sub
So I have some threads where I would like to pass an upvalue called reset to each thread once every so often in order to reset each thread's table's values. I then want to switch off the reset until the table has finished iterating through its batches. However I have had no success in switching off the reset (reset = false) doesn't seem to stop it from continuously resetting.
for i = 1, n do
local reset = true
while true do
threads:addjob(
function()
if reset = true then f:reset(); reset = false; end
x,y = f:getBatch()
return x,y
end,
function(x,y)
-- do some stuff and trigger conditionMet = true if met
end
)
if conditionMet == true break end
end
end
Your upvalue "reset" here is read-only. The thread serializes "reset" and read it. So every iteration in the "while" loop, reset is read and serialized again by threads:addjob.
What you seem to want instead is to break it down this way:
for i = 1, n do
threads:addjob(
function()
__resetflag = true
end
)
while true do
threads:addjob(
function()
if __resetflag == true then f:reset(); __resetflag = false; end
x,y = f:getBatch()
return x,y
end,
function(x,y)
-- do some stuff and trigger conditionMet = true if met
end
)
if conditionMet == true break end
end
end
i'm a but stuck with a snake game I am trying to make, it seems that at the moment the "HEAD" of the snake (this is a colored cell that is green with a green "x") will move perfectly and continuously till the end of the game playing board and stops at the boarder as i want. But it will not pickup any other key presses whilst it is moving.
Is there a way another key press can interrupt any other subs running.
I would really appreciate any help from you guys or maybe another way of doing it.
Option Explicit
Public speed As Integer
Dim r As Integer
Dim c As Integer
Dim moves As Boolean
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
...
Public Sub start()
Application.ScreenUpdating = False
Application.OnKey "{LEFT}", "k_left"
Application.OnKey "{UP}", "k_up"
Application.OnKey "{DOWN}", "k_down"
Application.OnKey "{RIGHT}", "k_right"
Application.ScreenUpdating = True
End Sub
....
Function go_Speed(x As Integer)
speed = 300 / x
End Function
....
Sub movecheck()
Do While moves = True
Call k_move(r, c)
Loop
End Sub
....
Function k_move(rows As Integer, columns As Integer)
DoEvents
Sleep (speed)
Dim a As Range
For Each a In Range("E4:ak37")
If a.Value = "x" Then
If a.Offset(rows, columns).Interior.Color <> RGB(255, 255, 255) Then
'''crash check call goes here
moves = False
Exit Function
Else
a.Interior.Color = RGB(255, 255, 255)
a.Offset(rows, columns).Interior.Color = RGB(78, 238, 148)
a.Offset(rows, columns).Font.Color = RGB(78, 238, 148)
a.Offset(rows, columns) = a.Value
a.Cells.Clear
a.Cells.BorderAround 1
movecheck
End If
End If
Next a
End Function
....
Sub k_left()
moves = False
r = 0
c = -1
moves = True
Call movecheck
End Sub
....
Sub k_up()
moves = False
r = -1
c = 0
moves = True
Call movecheck
End Sub
....
Sub k_down()
moves = False
r = 1
c = 0
moves = True
Call movecheck
End Sub
.....
Sub k_right()
moves = False
r = 0
c = 1
moves = True
Call movecheck
End Sub
.....
You can poll the keyboard in your sub before each step. Then do a
Public Declare Function GetKeyboardState Lib "user32" Alias "GetKeyboardState" (pbKeyState As Byte) As Long
dim keybrdbuff(255) as byte
For x = 0 to 255
If 0<>keybrdbuff(x) then Exit Sub
Next
GetKeyboardState Function
The GetKeyboardState function copies the status of the 256 virtual keys to the specified buffer.
Syntax
BOOL GetKeyboardState(PBYTE lpKeyState);
Parameters
lpKeyState
[in] Pointer to the 256-byte array that receives the status data for each virtual key.
Return Value
If the function succeeds, the return value is nonzero.
If the function fails, the return value is zero. To get extended error information, call GetLastError.
Remarks
An application can call this function to retrieve the current status of all the virtual keys. The status changes as a thread removes keyboard messages from its message queue. The status does not change as keyboard messages are posted to the thread's message queue, nor does it change as keyboard messages are posted to or retrieved from message queues of other threads. (Exception: Threads that are connected through AttachThreadInput share the same keyboard state.)
When the function returns, each member of the array pointed to by the lpKeyState parameter contains status data for a virtual key. If the high-order bit is 1, the key is down; otherwise, it is up. If the key is a toggle key, for example CAPS LOCK, then the low-order bit is 1 when the key is toggled and is 0 if the key is untoggled. The low-order bit is meaningless for non-toggle keys. A toggle key is said to be toggled when it is turned on. A toggle key's indicator light (if any) on the keyboard will be on when the key is toggled, and off when the key is untoggled.
To retrieve status information for an individual key, use the GetKeyState function. To retrieve the current state for an individual key regardless of whether the corresponding keyboard message has been retrieved from the message queue, use the GetAsyncKeyState function.
An application can use the virtual-key code constants VK_SHIFT, VK_CONTROL and VK_MENU as indices into the array pointed to by lpKeyState. This gives the status of the SHIFT, CTRL, or ALT keys without distinguishing between left and right. An application can also use the following virtual-key code constants as indices to distinguish between the left and right instances of those keys:
VK_LSHIFT
VK_RSHIFT
VK_LCONTROL
VK_RCONTROL
VK_LMENU
VK_RMENU
These left- and right-distinguishing constants are available to an application only through the GetKeyboardState, SetKeyboardState, GetAsyncKeyState, GetKeyState, and MapVirtualKey functions.
I am new to VBA coding. I have done some coding in Javascript and C++, so I do understand the concepts. I'm not too familiar with the specifics of VBA, though. This particular code is for Excel 2007. The sort function was copied from elsewhere as pseudocode (documentation is not mine). I've rewritten it as VBA (unsuccessfully).
This code is not working properly. The code is abruptly aborting entirely (not just jumping out of a loop or function, but quitting completely after going through the While loop twice.
To replicate the problem, save this code as a Macro for an Excel sheet, type the number 9853 in B5, and in B6 type "=Kaprekar(B5)". Essentially, run Kaprekar(9853).
Could someone please help me figure out what I'm doing wrong here? Thanks.
By the way, I'm using While-Wend now. I also tried Do While-Loop with the same result.
Here's the code:
Function Sort(A)
limit = UBound(A)
For i = 1 To limit
' A[ i ] is added in the sorted sequence A[0, .. i-1]
' save A[i] to make a hole at index iHole
Item = A(i)
iHole = i
' keep moving the hole to next smaller index until A[iHole - 1] is <= item
While ((iHole > 0) And (A(iHole - 1) > Item))
' move hole to next smaller index
A(iHole) = A(iHole - 1)
iHole = iHole - 1
Wend
' put item in the hole
A(iHole) = Item
Next i
Sort = A
End Function
Function Kaprekar%(Original%)
Dim Ord(0 To 3) As Integer
Ord(0) = Original \ 1000
Ord(1) = (Original - (Ord(0) * 1000)) \ 100
Ord(2) = (Original - (Ord(1) * 100) - (Ord(0) * 1000)) \ 10
Ord(3) = (Original - (Ord(2) * 10) - (Ord(1) * 100) - (Ord(0) * 1000))
If (Ord(0) = Ord(1)) * (Ord(1) = Ord(2)) * (Ord(2) = Ord(3)) * (Ord(3) = Ord(0)) = 1 Then
Kaprekar = -1
Exit Function
End If
Arr = Sort(Ord)
Kaprekar = Ord(3)
End Function
excel evaluates both items in the while statement, so
While ((ihole > 0) And (A(ihole - 1) > item))
when ihole=0, returns false for the first test, and out of bounds for the second test, bombing out of the function with a #Value error.
A quick bubblesort would be something like this:
Option Explicit
Function Sort(A)
Dim iLoop As Long
Dim jLoop As Long
Dim Last As Long
Dim Temp
Last = UBound(A)
For iLoop = 0 To Last - 1
For jLoop = iLoop + 1 To Last
If A(iLoop) > A(jLoop) Then
Temp = A(jLoop)
A(jLoop) = A(iLoop)
A(iLoop) = Temp
End If
Next jLoop
Next iLoop
Sort = A
End Function