如何修改VBA代码实现遇Sheet1列C空白单元格时停止循环

背景说明 #

• 工作簿中，每期会将已完成发票数据复制到Sheet1的C列；A列用于填写年份，B列用于填写财务周期（每年共13个周期）
• Sheet1的B列原本使用公式 =IF(C93<>"",Sheet2!$L$3,"")，该公式会检测C列是否有内容，若有则显示Sheet2指定单元格的当前周期，但需要在周期切换前将周期信息复制粘贴为值
• 最新版本中，Sheet2的Q列包含13个周期，P列标记周期是否已关闭；已改编代码可找到Sheet1 B列首个空白单元格，并将Sheet2中P列为空对应的Q列周期值填入，但需要修改为循环执行直到遇到Sheet1 C列的空白单元格时停止

原可正常运行的代码 #

Sub GetPeriod()
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    x = Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    x = srcWS.Range("P2:P" & srcWS.Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    With desWS
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = srcWS.Range("Q" & x)
    End With
End Sub

修改后存在问题的代码 #

尝试添加Do While循环，但代码未在C列空白单元格处停止，而是持续向下填充周期编号：

Sub GetPeriod()
    Dim LastRow As Long, srcWS As Worksheet, desWS As Worksheet, x As Long
    x = Range("A2:A" & Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    Set srcWS = Sheets("Sheet2")
    Set desWS = Sheets("Sheet1")
    Do While desWS.Range("C" & x) <> ""
    x = srcWS.Range("P2:P" & srcWS.Rows.Count).Cells.SpecialCells(xlCellTypeBlanks).Row
    With desWS
        .Cells(.Rows.Count, "B").End(xlUp).Offset(1) = srcWS.Range("Q" & x)
    End With
    
    Loop
End Sub

解决方案 #

问题出在循环逻辑的控制上：原代码中x的初始值逻辑混乱，且循环中未跟踪Sheet1 C列的当前行位置。以下是修正后的代码：

Sub GetPeriod()
    Dim srcWS As Worksheet, desWS As Worksheet
    Dim currentPeriodRow As Long, targetRow As Long
    
    ' 定义工作表对象
    Set srcWS = ThisWorkbook.Sheets("Sheet2")
    Set desWS = ThisWorkbook.Sheets("Sheet1")
    
    ' 获取Sheet2中P列第一个空白单元格对应的Q列周期行
    currentPeriodRow = srcWS.Range("P2:P" & srcWS.Rows.Count).SpecialCells(xlCellTypeBlanks).Row
    ' 获取Sheet1中B列第一个需要填充的空白行（即最后一行的下一行）
    targetRow = desWS.Cells(desWS.Rows.Count, "B").End(xlUp).Offset(1).Row
    
    ' 循环填充直到C列对应行为空
    Do While desWS.Range("C" & targetRow).Value <> ""
        ' 填充当前周期到B列
        desWS.Range("B" & targetRow).Value = srcWS.Range("Q" & currentPeriodRow).Value
        ' 移动到下一行
        targetRow = targetRow + 1
    Loop
End Sub

代码说明 #

1. 明确工作表引用：使用ThisWorkbook确保引用当前工作簿的工作表，避免激活其他工作簿时出错
2. 固定当前周期：提前获取Sheet2中当前未关闭的周期（P列空白对应的Q列值），避免循环中重复查找
3. 跟踪目标行：从Sheet1 B列第一个空白行开始，逐行检查C列是否有内容，有则填充周期，直到C列对应行空白时停止循环

内容的提问来源于stack exchange，提问作者Scott