修改Excel VBA拆分代码：按C列拆分数据并以AF2值命名工作表

问题1修改方案（拆分列从A列改为C列） #

你需要修改代码中3处对应A列（列索引为1）的参数，替换为C列对应的列索引3即可：

• 统计最后一行的代码：xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row 把1改为3
• 收集唯一值的循环代码：Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text) 把两处1都改为3
• 筛选数据的代码：Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I))) 把1改为3

问题2修改方案（新工作表以AF2单元格值命名） #

需要调整命名逻辑的执行顺序，先完成数据复制再读取AF2的值命名，同时增加容错处理避免空值、非法字符导致的命名报错，修改后完整代码如下：

Sub parse_data()
Dim xRCount As Long
Dim xSht As Worksheet
Dim xNSht As Worksheet
Dim I As Long
Dim xTRrow As Integer
Dim xCol As New Collection
Dim xTitle As String
Dim xSUpdate As Boolean
Dim xNewName As String
Set xSht = ActiveSheet
On Error Resume Next
' 按C列统计最后一行
xRCount = xSht.Cells(xSht.Rows.Count, 3).End(xlUp).Row
xTitle = "A1:AD1"
xTRrow = xSht.Range(xTitle).Cells(1).Row
For I = 2 To xRCount
    ' 收集C列唯一值
    Call xCol.Add(xSht.Cells(I, 3).Text, xSht.Cells(I, 3).Text)
Next
xSUpdate = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCol.Count
    ' 按C列筛选
    Call xSht.Range(xTitle).AutoFilter(3, CStr(xCol.Item(I)))
    Set xNSht = Nothing
    ' 新建工作表
    Set xNSht = Worksheets.Add(, Sheets(Sheets.Count))
    ' 复制筛选后的数据
    xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1")
    xNSht.Columns.AutoFit
    ' 读取AF2的值作为工作表名，处理非法字符、空值和长度限制
    xNewName = xNSht.Range("AF2").Text
    If xNewName = "" Then xNewName = "未命名_" & I
    xNewName = Left(Replace(Replace(Replace(Replace(Replace(xNewName, "/", ""), "\", ""), "?", ""), "*", ""), ":", ""), 31)
    On Error Resume Next
    xNSht.Name = xNewName
    On Error GoTo 0
Next
xSht.AutoFilterMode = False
xSht.Activate
Application.ScreenUpdating = xSUpdate
End Sub

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