共享工作簿中VBA TextToColumns失效，求替代及批量处理方案

问题背景 #

此前通过VBA的TextToColumns函数实现将G列文本按分隔符“-”拆分到后续列，但Excel设为共享工作簿后该函数失效。需要修改仅支持单个单元格处理的Split代码，实现对选中所有单元格的批量处理。

原TextToColumns代码：

Private Sub Generate_Click()
  Dim destRng As Range
    If Selection.Columns.Count = 1 And ActiveCell.Column = 7 Then
    'Set destRng = Range("G4")  instead this
    
        Selection.TextToColumns , Destination:=Range("H" & Selection.Row), _
        DataType:=xlDelimited, Other:=True, OtherChar:"-", Other:=False, OtherChar:"_"
    
        Else
        MsgBox "Mark only column G"
        End If
    
End Sub

现有单个单元格处理的Split代码：

Private Sub Generate_Click()
  Dim splitVals As Variant
  Dim totalVals As Long
    If Selection.Columns.Count = 1 And ActiveCell.Column = 7 Then
   
        splitVals = Split(ActiveCell.Value, "-")
        totalVals = UBound(splitVals)

        Range(Cells(ActiveCell.Row, ActiveCell.Column + 1), Cells(ActiveCell.Row, ActiveCell.Column + 1 + totalVals)).Value = splitVals

        Else
        MsgBox "Mark only column G"
        End If
    
End Sub

修改后的批量拆分代码（兼容共享工作簿） #

Private Sub Generate_Click()
    Dim cell As Range
    Dim splitVals As Variant
    Dim colCount As Integer
    
    ' 校验选中区域是否为G列单列
    If Selection.Columns.Count <> 1 Or Selection.Column <> 7 Then
        MsgBox "请仅选中G列的单元格"
        Exit Sub
    End If
    
    ' 遍历选中的每个单元格
    For Each cell In Selection
        ' 跳过空单元格
        If Trim(cell.Value) <> "" Then
            ' 按"-"拆分文本内容
            splitVals = Split(cell.Value, "-")
            ' 获取拆分后的元素数量
            colCount = UBound(splitVals) + 1
            ' 将拆分结果写入当前单元格右侧的对应列
            cell.Offset(0, 1).Resize(1, colCount).Value = splitVals
        End If
    Next cell
End Sub

代码说明 #

• 严格校验选中区域，仅允许处理G列单列选中的情况，避免误操作
• 遍历选中的所有单元格，实现批量拆分处理
• 自动跳过空单元格，减少无效执行步骤
• 通过Offset定位起始写入列，Resize适配拆分结果的长度，确保内容准确写入对应位置
• 完全兼容共享工作簿环境，替代失效的TextToColumns函数

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