Question

我发现了一些具有类似标题的线程，但实际上并不是我想做的事情。我要做的是浏览Col A中的数字列表，并使用NetworkDays计算时间差，第一个例子是Col B'Received On'中显示的数字，最后一个实例是Col C中出现的数字'处理'。在完成NetworkDays计算之后，我想将该值重复放在每个相应行的Col D中。值在Col A中出现的次数会不断变化，而Col A本身长达数千行且不断增长。完成后，我需要遍历Col A中所有其他不同的数字集并重复该过程。例如，*** 39430首先出现在第2行，最后出现在第7行。使用Networkdays（B2，C7）给出11天，依此类推。之后转到*** 39383。以下示例。

Sample data

以下是我到目前为止的代码。从上面的示例我必须在*** 39430下面放一个空行以使代码工作，否则它只是继续到列表的底部并计算差异（显然不是我想要的）。我感到困惑的是，当Col A中的值发生变化然后继续时，如何告诉循环重新启动。我怀疑它可能接近DoCoreCell.Value＆lt;＆gt; Activecell.Offset（-1,0）.Value但我无法弄明白。另外，如何在每个相应的行上重复Networkdays值。

Dim counter As Integer
Dim CycleTime As Long

counter = 0

Do Until ActiveCell.Value = ""
counter = counter + 1


ActiveCell.Offset(1, 0).Select
Loop

'Gives the number of rows to offset
MsgBox counter

'Shows the correct number of days difference
MsgBox WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
CycleTime = WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
Range("D2").Value = CycleTime

非常感谢任何帮助。提前致谢。

更新

使用几周后提供的代码后，我注意到了之前没有想过的并发症。以前，我曾经认为每个输入文档总是只有一个输出文档（在原始问题的范围内没有考虑），但是如上面的示例 - 新图像所示，每个输入文档可以有多个输出文档。对于下面的新屏幕截图，我添加了两个额外的列，Col.C'Output Doc＃'和Col.D'Output Doc Created On'。我希望能够做的是修改@ YowE3K下面提供的代码，是嵌套另一个循环，通过Col.D'Putput Doc＃'并使用NetworkDays来计算第一个与B1和D1的差异。组，然后B1和D8为第二组。就像现在一样，代码不会编写来处理更改并计算所有内容，如列F所示，理想代码生成列G.第二个框（深蓝色）显示代码执行完美的典型示例。循环是我正在努力理解的东西，而不是真正确定如何对此进行攻击。对响应中的代码的任何评论都会非常有用。提前致谢。

Sample - New

Answer 1

以下代码循环使用endRow作为循环＆＃34;计数器＆＃34;。

startRow设置为包含当前＆＃34; Doc Number＆＃34;的开头的行，并且endRow递增，直到它指向该行的最后一行＆＃34 ; Doc Number＆＃34;。

endRow指向正确的位置后，会计算CycleTime并将其写入startRow到endRow的每一行的D列。然后将startRow设置为指向下一个＆＃34; Doc Number＆＃34;的开头。

当在A列中找到空白单元格时，循环结束。

Sub Calc()

    Dim startRow As Long
    Dim endRow As Long
    Dim CycleTime As Long

    startRow = 2
    endRow = 2
    Do
        If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
            CycleTime = WorksheetFunction.NetworkDays(Cells(startRow, "B"), Cells(endRow, "C"))
            Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
            startRow = endRow + 1
        End If
        endRow = endRow + 1
        If Cells(endRow, "A").Value = "" Then
            Exit Do
        End If
    Loop

End Sub

编辑以跟踪第一个和最后一个＆＃34;已批准＆＃34;记录，如果找到，则只更新D列：

Sub Calc()

    Dim startRow As Long    'Start of the Doc Number
    Dim firstRow As Long    'First "approved" row
    Dim lastRow As Long     'Last "approved" row
    Dim endRow As Long      'End of the Doc Number
    Dim CycleTime As Long

    startRow = 2
    endRow = 2
    firstRow = -1
    lastRow = -1

    Do
        If Cells(endRow, "Q").Value = "Approved" Then
            'Found an "Approved" record

            'Set the first row if not already set
            If firstRow = -1 Then
                firstRow = endRow
            End If

            'Set the last row (will replace this if we find another record)
            lastRow = endRow
        End If

        If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
            If firstRow > 0 Then ' (If it is -1 then we never found an "Approved" record)
                CycleTime = WorksheetFunction.NetworkDays(Cells(firstRow, "B"), Cells(lastRow, "C"))
                Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
            End If
            'Set up for next Doc Number
            startRow = endRow + 1
            firstRow = -1
            lastRow = -1
        End If
        'Go to next row
        endRow = endRow + 1
        'Exit when we hit a blank Doc Number
        If Cells(currentRow, "A").Value = "" Then
            Exit Do
        End If
    Loop

End Sub

当值更改时，循环列重新启动

1 个答案: