修改VBA循环：仅当遇到相邻两个空单元格时终止

我需要在工作表的列中循环，为每个非空单元格新建工作表。该列存在单个空单元格作为分隔符（导出内容无法修改），但当前循环遇到单个空单元格就停止了，必须修改循环逻辑，让它只有遇到相邻两个空单元格时才终止。

当前代码 #

Option Explicit
Sub AddSheets()
Dim wks As Worksheet
Dim wksNew As Worksheet
Dim rngCell As Range

Set wks = Sheets("Manual")
Set rngCell = wks.Range("B5")

While Not IsEmpty(rngCell)
    Set wksNew = ActiveWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
    wksNew.Name = rngCell.Value

    'do stuff with wksNew

    Set rngCell = rngCell.Offset(1)
Wend

End Sub

列数据结构 #

修改后的代码 #

Option Explicit
Sub AddSheets()
Dim wks As Worksheet
Dim wksNew As Worksheet
Dim rngCell As Range

Set wks = Sheets("Manual")
Set rngCell = wks.Range("B5")

' 循环终止条件：当前单元格和下一个单元格同时为空
Do While Not (IsEmpty(rngCell) And IsEmpty(rngCell.Offset(1)))
    ' 仅处理非空单元格
    If Not IsEmpty(rngCell) Then
        Set wksNew = ActiveWorkbook.Worksheets.Add(After:=Sheets(Sheets.Count))
        wksNew.Name = rngCell.Value

        ' 这里执行对新工作表的操作
        'do stuff with wksNew
    End If
    
    ' 向下移动一个单元格
    Set rngCell = rngCell.Offset(1)
Loop

End Sub

关键修改点 #

1. 循环条件调整：用Do While替代原While，判断逻辑改为「当前单元格和下一个单元格不同时为空」，确保只有连续两个空单元格才会终止循环
2. 增加非空判断：只有当前单元格有内容时才新建工作表，避免空单元格触发无效操作
3. 遍历逻辑优化：每次循环都向下移动单元格，不管当前是否为空，保证遍历到连续空单元格为止

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