VBA에서 배열을 순환적으로 이동하는 방법
문제
나는 배열 (1,2,3)을 가지고 있고 예를 들어 (3,1,2) 또는 (2,3,1)을 얻기 위해 순환 이동을 수행하고 싶습니다.Matlab에서는 다음 코드를 사용하여 이를 수행하는 방법을 알고 있습니다.
Y = circshift(A,K)
이 작업을 도와주실 수 있나요?샘플 코드를 주시면 감사하겠습니다...
해결책 2
Option Explicit
Option Base 1
Sub shiftCircArray()
Dim iInputArray(3) As Integer
iInputArray(1) = 1
iInputArray(2) = 2
iInputArray(3) = 3
Dim iArray2() As Integer
iArray2 = RotateArrayRight(iInputArray)
End Sub
Function RotateArrayRight(ArrayToRotate)
Dim objNewArray() As Integer, iOldArrayPos As Integer, iNewArrayPos As Integer, iArrayLength
As Integer
Dim iPlacesToRotate As Integer
' Check that the array to be processed has been initialized
iPlacesToRotate = Application.CountA(ArrayToRotate)
If iPlacesToRotate <> 0 Then
' Check that the number of places to rotate is greater than zero - running the
' function with a value
' of places to rotate which is less than zero would cause problems, possibly causing
'the function to crash
If iPlacesToRotate > 0 Then
' get the length of the array to rotate, we'll be using it a few times so will
' load it into a local variable at the start of the function
iArrayLength = Application.CountA(ArrayToRotate)
' Array will be initialised from 0 to ArrayLength -1
' so it will contain ArrayLength elements
ReDim objNewArray(iArrayLength)
' This will remove any extra complete rotations through the array
' The mod operator returns the remainder of an integer divide operation
' Initialise the array position indexes
iOldArrayPos = iPlacesToRotate
iNewArrayPos = 1
' Copy objects from one array to the next
' First start at iPlacesToRotate into the old array
' and copy to the start of the new array.
While iOldArrayPos < iArrayLength + 1
objNewArray(iNewArrayPos) = ArrayToRotate(iOldArrayPos)
iOldArrayPos = iOldArrayPos + 1
iNewArrayPos = iNewArrayPos + 1
Wend
iOldArrayPos = 1
' Copy from the start of the old array into the end of the
' new array
While iOldArrayPos < iPlacesToRotate
objNewArray(iNewArrayPos) = ArrayToRotate(iOldArrayPos)
iOldArrayPos = iOldArrayPos + 1
iNewArrayPos = iNewArrayPos + 1
Wend
Else
MsgBox ("Values for 'Places to Rotate' must be greater than zero.")
End If
Else
MsgBox ("Cannot rotate an null array.")
End If
RotateArrayRight = objNewArray()
End Function
다른 팁
암호:
Private Function RotateArrayRight(ByVal ArrayToRotate As Object(), ByVal iPlacesToRotate As Integer) As Object()
Dim objNewArray As Object()
Dim iOldArrayPos, iNewArrayPos As Integer
Dim iArrayLength As Integer
' Check that the array to be processed has been initialized
If Not ArrayToRotate Is Nothing Then
' Check that the number of places to rotate is greater than zero - running the function with a value
' of places to rotate whiich is less than zero would cause problems, possibly causing the function to crash
If iPlacesToRotate > 0 Then
' get the length of the array to rotate, we'll be using it a few times so will
' load it into a local variable at the start of the function
iArrayLength = ArrayToRotate.Length
' Array will be initialised from 0 to ArrayLength -1
' so it will contain ArrayLength elements
ReDim objNewArray(iArrayLength - 1)
' This will remove any extra complete rotations through the array
' The mod operator returns trhe remainder of an integer divide operation
iPlacesToRotate = iPlacesToRotate Mod iArrayLength
' Initialise the array position indexes
iOldArrayPos = iPlacesToRotate
iNewArrayPos = 0
' Copy objects from one array to the next
' First start at iPlacesToRotate into the old array
' and copy to the start of the new array.
While iOldArrayPos < iArrayLength
objNewArray(iNewArrayPos) = ArrayToRotate(iOldArrayPos)
iOldArrayPos += 1
iNewArrayPos += 1
End While
iOldArrayPos = 0
' Copy from the start of the old array into the end of the
' new array
While iOldArrayPos < iPlacesToRotate
objNewArray(iNewArrayPos) = ArrayToRotate(iOldArrayPos)
iOldArrayPos += 1
iNewArrayPos += 1
End While
Else
Throw New ArgumentOutOfRangeException("Values for 'Places to Rotate' must be greater than zero.")
End If
Else
Throw New NullReferenceException("Cannot rotate an null array.")
End If
Return objNewArray
End Function
이 기능을 예를 들어 사용할 수 있습니다.
Dim iInputArray() As Object
iInputArray = {4, 9, 2, 1}
Dim iArray2(), iArray3() As Object
iArray2 = RotateArrayRight(iInputArray, 2) ' Shift right two positions
iArray3 = RotateArrayRight(iInputArray, 98977) ' Shift right 98977 positions
편집하다:
iOldArrayPos += 1 => iOldArrayPos = iOldArrayPos+ 1
End While => Wend
Throw => MsgBox
제휴하지 않습니다 StackOverflow