Excel求助：如何通过循环读取列表值并设置工作表名称？

我来帮你搞定这个循环问题！核心需求就是遍历Sheet1的A列非空单元格，把每个单元格的值对应到工作表名称上，直到碰到空行停止。下面是一步步的实现方案和完整代码：

1. 核心思路拆解 #

• 从A列的起始行（比如A1，要是有表头就从A2开始）逐个检查单元格
• 只要单元格非空，就用它的值去关联对应的工作表
• 遇到空单元格时立刻终止循环

2. 完整VBA代码示例 #

Sub LoopThroughSheetNames()
    Dim wsSource As Worksheet
    Dim currentCell As Range
    Dim targetSheet As Worksheet
    Dim sheetName As String
    
    ' 指定数据源为Sheet1
    Set wsSource = ThisWorkbook.Worksheets("Sheet1")
    ' 从A1开始遍历，需要的话可以改成A2跳过表头
    Set currentCell = wsSource.Range("A1")
    
    ' 循环直到遇到空单元格
    Do While currentCell.Value <> ""
        sheetName = currentCell.Value
        
        ' 先检查目标工作表是否存在，避免报错崩溃
        On Error Resume Next
        Set targetSheet = ThisWorkbook.Worksheets(sheetName)
        On Error GoTo 0
        
        If Not targetSheet Is Nothing Then
            ' 这里写你要对目标工作表执行的操作
            ' 示例：在目标工作表的B1写入关联标记
            targetSheet.Range("B1").Value = "关联自Sheet1：" & sheetName
            ' 用完后清空对象变量，防止下次循环误用上一次的结果
            Set targetSheet = Nothing
        Else
            ' 工作表不存在时的处理，可选提示或创建
            MsgBox "工作表 '" & sheetName & "' 不存在，已跳过该行"
        End If
        
        ' 移动到下一行继续遍历
        Set currentCell = currentCell.Offset(1, 0)
    Loop
    
    MsgBox "循环执行完成！"
End Sub

3. 代码关键点说明 #

• Do While循环：比固定次数的For循环更适配“直到空行停止”的场景，不用提前统计行数
• 错误捕获：On Error Resume Next用来处理“工作表不存在”的情况，避免程序直接报错退出
• Offset方法：每次循环把单元格下移一行，实现逐行遍历
• 对象清空：Set targetSheet = Nothing能确保每次循环都是全新的对象判断，不会有残留问题

4. 额外优化建议 #

• 如果A列有重复的工作表名称，可以在循环前先对列表去重，避免重复操作
• 如果需要自动创建不存在的工作表，可以把提示代码替换成创建逻辑：

  Set targetSheet = ThisWorkbook.Worksheets.Add(After:=ThisWorkbook.Worksheets(ThisWorkbook.Worksheets.Count))
  targetSheet.Name = sheetName
  

• 要是A列中间有空行但后面还有数据，可以改成Do Until currentCell Is Nothing，同时在循环内判断单元格是否为空，不过一般连续的列表用第一种循环就足够了

内容的提问来源于stack exchange，提问作者F.Rojas