使用 VBA 根据逻辑动态循环数组的元素
Loop in elements of Array dynamically based on logic using VBA
我正在编写一段代码,使用 VBA 中的数组概念来选取当前和下一季度的值。
但是,当 运行 以下代码时,我遇到运行时错误 13。
Sub PlaceTheQuarter()
Dim arr, Q1, Q2, Q3, Q4
arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
Q1 = Array("Jan", "Feb", "Mar")
Q2 = Array("Apr", "May", "Jun")
Q3 = Array("Jul", "Aug", "Sep")
Q4 = Array("Oct", "Nov", "Dec")
'MsgBox (Application.Match(Application.RoundUp(Month(Date) / 3, 0)))
MsgBox (arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0)))
'ENABLE THIS PART TO TEST Q4 ITERATION
Dim idate As Date
idate = "31-DEC-2020"
a = arr(Application.Match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))
'a = arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0))
i = Mid(a, 2, 1)
Dim next_q As Integer
If i = 4 Then
next_q = 1
Else
next_q = i + 1
End If
MsgBox ("Next Quarter is: Q" & next_q)
MsgBox (MonthName(Month(idate), True))
counter = 0
Dim n_quarter
n_quarter = "Q" & next_q
For Each ab In Q4
If MonthName(Month(idate), True) = ab Then
MsgBox ab
Dim pos As Integer
pos = Application.Match(ab, Q4, False)
MsgBox pos
Else
End If
Next
End Sub
基本上在 Foreach 循环中,如果我手动使用季度名称作为 Q4,它会在 fine.But 中循环,我想根据 Q&next_q
之类的值动态传递它。我已经分配了一个字符串值并在此处传递该变量,这在我的情况下都不起作用。
非常感谢任何对此的指点...
我的目的是让相应的季度数组随着一年中日期的推移而循环。
请测试下一个代码。它应该按照您在上一条评论中的要求(我理解):
Sub PlaceTheQuarter()
Dim arr, arrQ, Q1, Q2, Q3, Q4, ab, a As String, i As Long, k As Long
Dim next_q As Long, next_month As Long, arrFin, j As Long, actQ As Long
arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
Q1 = Array("Jan", "Feb", "Mar")
Q2 = Array("Apr", "May", "Jun")
Q3 = Array("Jul", "Aug", "Sep")
Q4 = Array("Oct", "Nov", "Dec")
arrQ = Array(Q1, Q2, Q3, Q4)
Dim idate As Date: idate = Date '"02.10.2021"
a = arr(Application.match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))
Select Case a
Case "Q1": next_month = Month(idate): actQ = 0
Case "Q2": next_month = Month(idate) - 3: actQ = 1
Case "Q3": next_month = Month(idate) - 6: actQ = 2
Case "Q4": next_month = Month(idate) - 9: actQ = 3
End Select
ReDim arrFin((3 - next_month) + 2)
i = Mid(a, 2, 1)
If i = 4 Then
next_q = 1
Else
next_q = i + 1
End If
'fill the final array containing the remained month plus the next quarter months:
For j = next_month To 2
arrFin(k) = arrQ(actQ)(j): k = k + 1
Next j
For j = 0 To 2
arrFin(k) = arrQ(next_q - 1)(j): k = k + 1
Next j
'______________________________________________________
'Iterate between the necessary array elements:
For Each ab In arrFin
Debug.Print ab
Next
End Sub
我正在编写一段代码,使用 VBA 中的数组概念来选取当前和下一季度的值。 但是,当 运行 以下代码时,我遇到运行时错误 13。
Sub PlaceTheQuarter()
Dim arr, Q1, Q2, Q3, Q4
arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
Q1 = Array("Jan", "Feb", "Mar")
Q2 = Array("Apr", "May", "Jun")
Q3 = Array("Jul", "Aug", "Sep")
Q4 = Array("Oct", "Nov", "Dec")
'MsgBox (Application.Match(Application.RoundUp(Month(Date) / 3, 0)))
MsgBox (arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0)))
'ENABLE THIS PART TO TEST Q4 ITERATION
Dim idate As Date
idate = "31-DEC-2020"
a = arr(Application.Match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))
'a = arr(Application.Match(Application.RoundUp(Month(Date) / 3, 0), arr, 0))
i = Mid(a, 2, 1)
Dim next_q As Integer
If i = 4 Then
next_q = 1
Else
next_q = i + 1
End If
MsgBox ("Next Quarter is: Q" & next_q)
MsgBox (MonthName(Month(idate), True))
counter = 0
Dim n_quarter
n_quarter = "Q" & next_q
For Each ab In Q4
If MonthName(Month(idate), True) = ab Then
MsgBox ab
Dim pos As Integer
pos = Application.Match(ab, Q4, False)
MsgBox pos
Else
End If
Next
End Sub
基本上在 Foreach 循环中,如果我手动使用季度名称作为 Q4,它会在 fine.But 中循环,我想根据 Q&next_q
之类的值动态传递它。我已经分配了一个字符串值并在此处传递该变量,这在我的情况下都不起作用。
非常感谢任何对此的指点...
我的目的是让相应的季度数组随着一年中日期的推移而循环。
请测试下一个代码。它应该按照您在上一条评论中的要求(我理解):
Sub PlaceTheQuarter()
Dim arr, arrQ, Q1, Q2, Q3, Q4, ab, a As String, i As Long, k As Long
Dim next_q As Long, next_month As Long, arrFin, j As Long, actQ As Long
arr = Array(1, "Q1", 2, "Q2", 3, "Q3", 4, "Q4")
Q1 = Array("Jan", "Feb", "Mar")
Q2 = Array("Apr", "May", "Jun")
Q3 = Array("Jul", "Aug", "Sep")
Q4 = Array("Oct", "Nov", "Dec")
arrQ = Array(Q1, Q2, Q3, Q4)
Dim idate As Date: idate = Date '"02.10.2021"
a = arr(Application.match(Application.RoundUp(Month(idate) / 3, 0), arr, 0))
Select Case a
Case "Q1": next_month = Month(idate): actQ = 0
Case "Q2": next_month = Month(idate) - 3: actQ = 1
Case "Q3": next_month = Month(idate) - 6: actQ = 2
Case "Q4": next_month = Month(idate) - 9: actQ = 3
End Select
ReDim arrFin((3 - next_month) + 2)
i = Mid(a, 2, 1)
If i = 4 Then
next_q = 1
Else
next_q = i + 1
End If
'fill the final array containing the remained month plus the next quarter months:
For j = next_month To 2
arrFin(k) = arrQ(actQ)(j): k = k + 1
Next j
For j = 0 To 2
arrFin(k) = arrQ(next_q - 1)(j): k = k + 1
Next j
'______________________________________________________
'Iterate between the necessary array elements:
For Each ab In arrFin
Debug.Print ab
Next
End Sub