如何在VBA中遍历、保存并格式化员工报表单元格数据？

我手头有一份自动生成的员工信息报表，里面的员工数量每天都不一样，现在需要把表格里的原始数据转换成特定格式。我觉得用For Each循环（比如For Each Cell In ActiveSheet.UsedRange.Cells）应该可行，但搞不清循环里的逻辑该怎么写，希望能得到帮助！

原始表格数据 #

John Smith 5/26/2018 12345 IT Pro John Gault Permitting Sarasota Winston Smith 5/30/2018 54321 Henchman Bob Licensing Oceania

目标输出格式 #

Name: John Smith 
Date Starting: 5/26/2018 
Employee ID#: 12345 
Title: IT PRO 
Supervisor: John Gault 
Bus Ctr: Permitting 
Location: Sarasota 

Name: Winston Smith 
Date Starting: 5/30/2018 
Employee ID#: 54321 
Title: Henchman 
Supervisor: Bob 
Bus Ctr: Licensing 
Location: Oceania 

解决方案（VBA代码） #

这里我们可以用For Each循环遍历单元格，同时用一个计数器跟踪当前处理到员工数据的哪个字段（每个员工固定占7个连续字段：姓名、入职日期、ID、职位、主管、业务中心、地点），完美匹配你想用For Each的需求：

Sub ConvertEmployeeData()
    Dim cell As Range
    Dim fieldCounter As Integer
    Dim outputText As String
    Dim employeeCount As Integer
    
    fieldCounter = 1
    outputText = ""
    employeeCount = 0
    
    '遍历工作表中所有已使用的单元格
    For Each cell In ActiveSheet.UsedRange.Cells
        '跳过空单元格，避免报表空白行干扰逻辑
        If cell.Value <> "" Then
            Select Case fieldCounter
                Case 1
                    employeeCount = employeeCount + 1
                    outputText = outputText & "Name: " & cell.Value & vbCrLf
                Case 2
                    outputText = outputText & "Date Starting: " & cell.Value & vbCrLf
                Case 3
                    outputText = outputText & "Employee ID#: " & cell.Value & vbCrLf
                Case 4
                    '将职位转为大写，匹配目标格式的要求
                    outputText = outputText & "Title: " & UCase(cell.Value) & vbCrLf
                Case 5
                    outputText = outputText & "Supervisor: " & cell.Value & vbCrLf
                Case 6
                    outputText = outputText & "Bus Ctr: " & cell.Value & vbCrLf
                Case 7
                    outputText = outputText & "Location: " & cell.Value & vbCrLf & vbCrLf
                    '重置计数器，准备处理下一位员工
                    fieldCounter = 0
            End Select
            fieldCounter = fieldCounter + 1
        End If
    Next cell
    
    '示例：将结果输出到新工作表，也可改为输出到文本文件或弹窗显示
    Dim newSheet As Worksheet
    Set newSheet = ThisWorkbook.Sheets.Add
    newSheet.Range("A1").Value = outputText
    '若要弹窗查看结果，可替换为：MsgBox outputText
End Sub

代码逻辑说明 #

• 字段计数器fieldCounter：核心逻辑，用来标记当前处理的是员工的第几个属性，每处理完7个字段（一位员工的全部信息）就重置，自动切换到下一位员工。
• 空单元格过滤：跳过报表中的空白单元格，避免因报表格式问题导致计数混乱。
• 格式匹配处理：用UCase()函数将职位字段转为大写，完全贴合目标格式的要求。
• 灵活输出：示例将结果输出到新工作表，你可以根据需求改成写入文本文件、弹窗显示或者替换原表格内容。

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