使用VBA根据逻辑动态循环数组元素

Posted 2023-03-27

【中文标题】使用VBA根据逻辑动态循环数组元素

【英文标题】：Loop in elements of Array dynamically based on logic using VBA

【发布时间】：2021-04-21 23:04:48

【问题描述】：

我正在编写一段代码来使用 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，它会很好地循环。但我想根据 Q&next_q 之类的值动态传递它。我已经分配了一个字符串值并传递了该变量这在我的情况下也不起作用。

对此的任何指示都非常感谢......

我的目的是让相应的季度数组随着一年中日期的推移而循环。

【问题讨论】：

你能描述一下代码应该做什么吗？最好将说明添加到您的帖子中。

基本上，如果您考虑最后一个 for 循环，我会尝试从数组中查找月份的出现或索引..但是代码是硬编码的测试..因为测试工作正常。我想获取要选择的特定季度的元素循环。例如：jan q1、Jun q2 等。

我更多地考虑如果你正在编写一个函数，那么将返回一个日期的季度或一个日期数组的季度数组或什么？或者，如果您正在编写子程序，它会做什么？

感谢您的回复。基本上子是试图找到当前和下一个季度的数字......创建ForEach循环的目的是找到当月的索引号在相应的 Quarter 数组中，稍后我将添加一些额外的代码来满足我的其他自动化要求......我目前想随着日期在一年中的进展为相应的 Quarter 动态调用 ForEach 循环......请告知

【参考方案1】：

请测试下一个代码。它应该像（我理解的）你在上一条评论中要求的那样：

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

【讨论】：

嗨@FaneDuru，我可以得到这个锯齿状数组使用背后的逻辑..谢谢你..但是，我在找到我期望在我的案例中构建的索引值时仍然面临问题进一步的逻辑。有什么建议吗？

@user2075017：“我在寻找索引值时仍然面临问题”并不是要告诉我太多，以便能够提供建议......请解释什么不起作用你需要，你只是说“但我想根据Q&next_q之类的值动态传递它”，这就是我试图解决的问题......

我明白了。所以如果我今天运行宏，for each 循环应该在第一季度运行，并告诉我 Jan 的索引为 1..如果我在 12 月的某一天运行它，它应该循环 foreach 循环第四季度和指数值应该是 3..我的主要目标是选择当前季度的当前和剩余月份以及下一个季度的月份，一旦发生季度编号的动态选择，这很容易，我正在寻求帮助。如果我之前感到困惑，Apols。

@user2075017：请测试更新的代码并发送一些反馈。

@user2075017：很高兴我能帮上忙！