Sub 分列() '以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗?请确定分列的数据会覆盖它后面的单元格!", _ vbYesNoCancel + vbQuestion) <> vbYes Then Exit Sub For Each m In Selection x = m.Column() y = m.Row() tmpStr = m.Value subStr = "" For i = 1 To Len(tmpStr) s = Mid(tmpStr, i, 1) If s = " " And subStr = "" Then '连续的空格,忽略 ElseIf s = " " And subStr <> " " Then '空格表示子串结束 Cells(y, x).Value = subStr subStr = "" x = x + 1 ElseIf s <> " " Then '新子串开始或进行中 subStr = subStr & s End If Next i If subStr <> "" Then Cells(y, x).Value = subStr Next m End Sub Sub 分列2() '以空格为分隔符,连续空格只算1个。对所选中的单元格进行处理 Dim m As Range, tmpStr As String, s As String Dim x As Integer, y As Integer, subStr As String If MsgBox("确定要分列处理吗?请确定分列的数据会覆盖它后面的单元格!", _ vbYesNoCancel + vbQuestion) <> vbYes Then Exit Sub For Each m In Selection x = m.Column() y = m.Row() tmpStr = m.Value subStr = "" For i = 1 To Len(tmpStr) s = Mid(tmpStr, i, 1) If s = "," And subStr = "" Then '连续的空格,忽略 ElseIf s = "," And subStr <> "," Then '空格表示子串结束 Cells(y, x).Value = subStr subStr = "" x = x + 1 ElseIf s <> "," Then '新子串开始或进行中 subStr = subStr & s End If Next i If subStr <> "" Then Cells(y, x).Value = subStr Next m End Sub