VBA 循环不迭代

Question

我正在开发一个项目，需要我搜索订单数据库，以便使用商品 ID 和订单日期提取商品数量。我对 VBA 还很陌生，所以我在这个项目中学到了很多东西，但我现在完全陷入困境了。

这是我当前的代码（ColumnLetters 是一个带有字母的简单数组）

' Define other methods and classes here
Public Function GetOrders(ItemNum As String, CutOff As Date)
    Dim N As Integer
    Dim CurrentRow As String
    Dim TotalOrders As Integer
    Dim ColumnLetters(0 To 25) As String
    Dim i As Integer
    Dim asciiValue As Integer
    Dim OrderDate As Date
    Dim LastRow As Integer
    Dim OrderQty As Integer
    Dim j As Integer

    LastRow = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row

    Sheet1.Select

    RowNum = WorksheetFunction.Sheet1.Match(ItemNum, Range("C1:C1000"), 0)

    asciiValue = Asc("D")

    For i = 0 To 22
        ColumnLetters(i) = Chr(asciiValue + i)
    Next i

    N = 0
    CurrentRow = "A" & ColumnLetters(N) & CStr(RowNum)
    OrderDate = Evaluate(Sheet1.Range(CurrentRow))

    OrderQty = 0

    Do
        For j = 1 To LastRow
            If Sheet2.Cells(j, 6).Value = ItemNum And Sheet2.Cells(j, 4).Value = OrderDate And OrderDate < CutOff Then
                OrderQty = OrderQty + Sheet2.Cells(j, 7).Value
            End If
        Next j
        N = N + 1
        CurrentRow = "A" & ColumnLetters(N) & CStr(RowNum)
        OrderDate = Evaluate(Sheet1.Range(CurrentRow))
        Debug.Print CurrentRow
    Loop Until OrderDate = 0

    GetOrders = OrderQty
    
End Function

但是，每当我运行代码时，外循环都不会迭代。直接终端仅显示单个 CurrentRow 值，没有其他内容。任何有帮助的想法将不胜感激。

复制 阅读完评论后，我尝试制作一个与 VBA 脚本一起使用的 Excel 工作表的简单可重现版本。

表 1： C 列：项目编号，在本例中我有 # DBA6001。

R 列：我在其中调用公共函数 GetOrders(C2,DATE(2024,6, 30))。 DATE 函数代表 CutOff 变量。

AD - AZ 列：这些列是我获取引用 Item# 的日期过滤列表的位置。对于我的例子，我有

=IFERROR(TRANSPOSE(FILTER('Open Order Report'!$D$1:$D$196,'Open Order Report'!$F$1:$F$196=C2)),"")

作为公式。这就是为什么我有 ColumnLetters 数组，根据需要迭代从 AD 到 AZ 的每一列。一旦列显示为空白，我想停止循环，因为这表明没有更多日期。

表 2（未结订单报告）： D 列：包含“发货”日期，在本示例中，我将其缩减为此列表。

F 列：每个订单的商品编号。 我用这个列表作为例子

G 栏：商品数量。 示例列表

如果我做错了，我深表歉意；这是我第一次在这里提问。如果需要更多信息，请告诉我，并提前感谢您的帮助！

编辑：根据请求，我附上了 3 个电子表格的屏幕截图。前 2 个位于 Sheet1 上，第二个位于 Sheet2 上。 一个、两个和三个

Answer 1

这是我根据我所了解的情况和你的问题的要求提出的。我省略了您可以根据需要添加的其他部分，但为了简单起见，此代码将与您想要实现的功能一起使用。

    Option Explicit
' Define other methods and classes here
Public Function GetOrders(ItemNum As String, CutOff As Date)

    Dim i As Long, lRow As Long, ws As Worksheet, total As Long
    Set ws = Application.Worksheets("Sheet2")
    lRow = ws.Cells(Rows.Count, 6).End(xlUp).Row ' count the rows at Col F (Item Numbers)
    
    ' check item number and add if the item matches and the cutoff date is less than the specified cutoff date.
    For i = 2 To lRow
        ' Debug.Print CDate(ws.Cells(i, 4).Value) & " ? " & nDate
        If ws.Cells(i, 6).Value = ItemNum And CDate(CutOff) >= CDate(ws.Cells(i, 4).Value) Then
            ' found the item with date before or on cutoff date
            total = total + ws.Cells(i, 7).Value
        End If
    Next i
    
    ' Debug.Print "Total Orders: " & total
    GetOrders = total

End Function

让我知道这是否适合您。

• AguilarPro