Do While Sheets("订单明细").Cells(currentRow, "C").Value = currentValue And currentRow <= lastRow 将代码修改为从当前行开始向下遍历c列，直到到达最后一行

以下是修改后的代码，实现从当前行开始向下遍历C列，直到到达最后一行：

Do While currentRow <= lastRow
    ' 获取当前行C列的值
    currentValue = Sheets("订单明细").Cells(currentRow, "C").Value
    
    ' 判断当前行C列的值是否和上一行相同
    If currentValue = Sheets("订单明细").Cells(currentRow - 1, "C").Value Then
        ' 如果相同，则继续向下遍历
        currentRow = currentRow + 1
    Else
        ' 如果不相同，则跳出循环
        Exit Do
    End If
Loop

这段代码会在每次循环中检查当前行的C列的值是否和上一行相同。如果相同，则继续向下遍历，直到找到不同的值或到达最后一行。如果不相同，则跳出循环。

请注意，这段代码是基于VBA语言的示例代码，需要在Excel VBA环境中运行。你可以根据实际情况进行调整和修改。

相关问题

Sub Macro1() Dim erow As Integer, Fsbill As String, r As Variant erow = Sheets("汇总").[a65536].End(xlUp).Row + 1 Fsbill = Range("i7") If Application.CountIf(Sheets("汇总").Range("c:c"), Fsbill) > 0 Then MsgBox "采购单号" & Fsbill & " was already exists !!!!" Exit Sub End If For r = 19 To 24 If Cells(r, 2) <> "" Then Sheets("汇总").Cells(erow, 1) = Month(Cells(8, 9)) Sheets("汇总").Cells(erow, 2) = Cells(8, 9) Sheets("汇总").Cells(erow, 3) = Cells(7, 9) Sheets("汇总").Cells(erow, 4) = Cells(7, 3) Sheets("汇总").Cells(erow, 5) = Cells(9, 9) Sheets("汇总").Cells(erow, 6) = Cells(10, 9) Sheets("汇总").Cells(erow, 7) = Cells(r, 2) Sheets("汇总").Cells(erow, 8) = Cells(r, 4) Sheets("汇总").Cells(erow, 9) = Cells(r, 5) Sheets("汇总").Cells(erow, 10) = Cells(r, 6) Sheets("汇总").Cells(erow, 11) = Cells(r, 7) Sheets("汇总").Cells(erow, 12) = Cells(r, 8) erow = erow + 1 End If Next Sheets("汇总").Select MsgBox "OK" End Sub这段VBA代码的作用，并详细分析每一行代码的作用

这段VBA代码的作用是将一个采购单的信息汇总到一个名为“汇总”的工作表中。具体来说，它首先检查采购单号是否已经存在于汇总工作表中，如果是，则弹出消息框并退出子程序。否则，它将从原始采购单中提取必要的信息，并将其写入汇总工作表中。

现在，我们逐行分析每一行代码的作用：

1. Dim erow As Integer, Fsbill As String, r As Variant
这一行定义了三个变量，“erow”表示下一个要写入的行号，“Fsbill”表示采购单号，“r”表示原始采购单中的行号。

2. erow = Sheets("汇总").[a65536].End(xlUp).Row + 1
这一行确定了下一个要写入的行号。它首先找到最后一个非空单元格的行号，然后将其加一。

3. Fsbill = Range("i7")
这一行将采购单号保存为一个字符串变量。

4. If Application.CountIf(Sheets("汇总").Range("c:c"), Fsbill) > 0 Then
这一行使用CountIf函数检查汇总工作表中是否已经存在具有相同采购单号的记录。

5. MsgBox "采购单号" & Fsbill & " was already exists !!!!" Exit Sub
如果存在具有相同采购单号的记录，则显示一个消息框并退出子程序。

6. For r = 19 To 24
这一行循环遍历原始采购单中的行号，这些行包含必要的信息。

7. If Cells(r, 2) <> "" Then
这一行检查原始采购单中当前行是否包含必要的信息。

8. Sheets("汇总").Cells(erow, 1) = Month(Cells(8, 9))
这一行将汇总表中的“月份”列设置为采购单中的月份。

9. Sheets("汇总").Cells(erow, 2) = Cells(8, 9)
这一行将汇总表中的“日期”列设置为采购单中的日期。

10. Sheets("汇总").Cells(erow, 3) = Cells(7, 9)
这一行将汇总表中的“供应商”列设置为采购单中的供应商。

11. Sheets("汇总").Cells(erow, 4) = Cells(7, 3)
这一行将汇总表中的“采购员”列设置为采购单中的采购员。

12. Sheets("汇总").Cells(erow, 5) = Cells(9, 9)
这一行将汇总表中的“部门”列设置为采购单中的部门。

13. Sheets("汇总").Cells(erow, 6) = Cells(10, 9)
这一行将汇总表中的“项目”列设置为采购单中的项目。

14. Sheets("汇总").Cells(erow, 7) = Cells(r, 2)
这一行将汇总表中的“物料名称”列设置为采购单中的物料名称。

15. Sheets("汇总").Cells(erow, 8) = Cells(r, 4)
这一行将汇总表中的“单位”列设置为采购单中的单位。

16. Sheets("汇总").Cells(erow, 9) = Cells(r, 5)
这一行将汇总表中的“数量”列设置为采购单中的数量。

17. Sheets("汇总").Cells(erow, 10) = Cells(r, 6)
这一行将汇总表中的“单价”列设置为采购单中的单价。

18. Sheets("汇总").Cells(erow, 11) = Cells(r, 7)
这一行将汇总表中的“总价”列设置为采购单中的总价。

19. Sheets("汇总").Cells(erow, 12) = Cells(r, 8)
这一行将汇总表中的“备注”列设置为采购单中的备注。

20. erow = erow + 1
这一行将下一个要写入的行号加一，以准备写入下一条记录。

21. End If
这一行结束了if语句块，表示完成了当前行的处理。

22. Next
这一行结束了for循环，表示已经处理完原始采购单中的所有行。

23. Sheets("汇总").Select
这一行将汇总工作表设置为当前激活的工作表。

24. MsgBox "OK"
这一行显示一个消息框，表示成功完成了子程序。

请为以下代码的每一句写上注释。Sub CopySameDay() Dim ws As Worksheet Dim lastRow As Long Dim i As Long Dim copyRange As Range Dim pasteRange As Range Dim wb As Workbook Dim folderPath As String Dim fileName As String Dim sumRange As Range Dim sumValue As Double Set ws = ActiveSheet lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row For i = 2 To lastRow If Format(ws.Range("D" & i).Value, "yyyy-mm-dd") = Format(ws.Range("D" & i - 1).Value, "yyyy-mm-dd") And ws.Range("B" & i).Value = ws.Range("B" & i - 1).Value Then If copyRange Is Nothing Then Set copyRange = ws.Range("A" & i - 1) End If Set pasteRange = ws.Range("A" & i) Else If Not copyRange Is Nothing Then folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) fileName = pasteRange.Offset(0, 1).Value & ".xlsx" If Dir(folderPath & fileName) = "" Then Set wb = Workbooks.Add wb.SaveAs folderPath & fileName Else Set wb = Workbooks.Open(folderPath & fileName) End If wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd") Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)) sumValue = Application.WorksheetFunction.Sum(sumRange) wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)).NumberFormat = "0.00" copyRange.Resize(i - copyRange.Row, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2") wb.Sheets(wb.Sheets.Count).Range("K" & (i - copyRange.Row + 2)).Value = sumValue ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1") wb.Save wb.Close Set copyRange = Nothing End If End If Next i If Not copyRange Is Nothing Then folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\")) fileName = pasteRange.Offset(0, 1).Value & ".xlsx" If Dir(folderPath & fileName) = "" Then Set wb = Workbooks.Add wb.SaveAs folderPath & fileName Else Set wb = Workbooks.Open(folderPath & fileName) End If wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd") Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)) sumValue = Application.WorksheetFunction.Sum(sumRange) wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)).NumberFormat = "0.00" copyRange.Resize(lastRow - copyRange.Row + 1, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2") wb.Sheets(wb.Sheets.Count).Range("K" & (lastRow - copyRange.Row + 3)).Value = sumValue ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1") wb.Save wb.Close End If End Sub

注释如下：

Sub CopySameDay()

' 定义变量
Dim ws As Worksheet ' 工作表
Dim lastRow As Long ' 最后一行
Dim i As Long ' 循环计数变量
Dim copyRange As Range ' 复制区域
Dim pasteRange As Range ' 粘贴区域
Dim wb As Workbook ' 工作簿
Dim folderPath As String ' 文件夹路径
Dim fileName As String ' 文件名
Dim sumRange As Range ' 求和区域
Dim sumValue As Double ' 求和结果

' 获取当前活动工作表
Set ws = ActiveSheet

' 获取最后一行
lastRow = ws.Cells(Rows.Count, "D").End(xlUp).Row

' 循环遍历行
For i = 2 To lastRow
    ' 判断是否为同一天且同一人
    If Format(ws.Range("D" & i).Value, "yyyy-mm-dd") = Format(ws.Range("D" & i - 1).Value, "yyyy-mm-dd") And ws.Range("B" & i).Value = ws.Range("B" & i - 1).Value Then
        ' 如果是，设置复制区域和粘贴区域
        If copyRange Is Nothing Then
            Set copyRange = ws.Range("A" & i - 1)
        End If
        Set pasteRange = ws.Range("A" & i)
    Else
        ' 如果不是，进行复制和粘贴操作
        If Not copyRange Is Nothing Then
            ' 获取文件夹路径和文件名
            folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\"))
            fileName = pasteRange.Offset(0, 1).Value & ".xlsx"
            ' 判断文件是否存在，不存在则新建，存在则打开
            If Dir(folderPath & fileName) = "" Then
                Set wb = Workbooks.Add
                wb.SaveAs folderPath & fileName
            Else
                Set wb = Workbooks.Open(folderPath & fileName)
            End If
            ' 在工作簿中添加新的工作表
            wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd")
            ' 获取求和区域和求和结果
            Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2))
            sumValue = Application.WorksheetFunction.Sum(sumRange)
            ' 设置求和区域的数字格式
            wb.Sheets(wb.Sheets.Count).Range("K2:K" & (i - copyRange.Row + 2)).NumberFormat = "0.00"
            ' 复制数据到新的工作表中
            copyRange.Resize(i - copyRange.Row, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2")
            ' 将求和结果写入新的工作表中
            wb.Sheets(wb.Sheets.Count).Range("K" & (i - copyRange.Row + 2)).Value = sumValue
            ' 将表头复制到新的工作表中
            ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1")
            ' 保存工作簿并关闭
            wb.Save
            wb.Close
            ' 清空复制区域
            Set copyRange = Nothing
        End If
    End If
Next i

' 如果仍有复制区域，进行最后一次复制和粘贴操作
If Not copyRange Is Nothing Then
    ' 获取文件夹路径和文件名
    folderPath = Left(ThisWorkbook.FullName, InStrRev(ThisWorkbook.FullName, "\"))
    fileName = pasteRange.Offset(0, 1).Value & ".xlsx"
    ' 判断文件是否存在，不存在则新建，存在则打开
    If Dir(folderPath & fileName) = "" Then
        Set wb = Workbooks.Add
        wb.SaveAs folderPath & fileName
    Else
        Set wb = Workbooks.Open(folderPath & fileName)
    End If
    ' 在工作簿中添加新的工作表
    wb.Sheets.Add(After:=wb.Sheets(wb.Sheets.Count)).Name = Format(copyRange.Offset(0, 3).Value, "yyyy-mm-dd")
    ' 获取求和区域和求和结果
    Set sumRange = wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3))
    sumValue = Application.WorksheetFunction.Sum(sumRange)
    ' 设置求和区域的数字格式
    wb.Sheets(wb.Sheets.Count).Range("K2:K" & (lastRow - copyRange.Row + 3)).NumberFormat = "0.00"
    ' 复制数据到新的工作表中
    copyRange.Resize(lastRow - copyRange.Row + 1, ws.Columns.Count).Copy wb.Sheets(wb.Sheets.Count).Range("A2")
    ' 将求和结果写入新的工作表中
    wb.Sheets(wb.Sheets.Count).Range("K" & (lastRow - copyRange.Row + 3)).Value = sumValue
    ' 将表头复制到新的工作表中
    ws.Rows(1).Copy wb.Sheets(wb.Sheets.Count).Range("A1")
    ' 保存工作簿并关闭
    wb.Save
    wb.Close
End If

End Sub