将一列分成多列

我想知道是否有人可以build议如何将一个逗号分隔的string拆分为多个字段。 我一直在试图弄清楚这一点，但一直都很难find一个好的解决scheme。 （也在网上查询，似乎有几个接近，但不一定适合我所需要的）

比方说，我有一个工作表，称之为“示例”，并在工作表中有多行下的string，但都在列“A”。

20120112,aaa,bbb,ccc,3432 20120113,aaa,bbb,ccc 20120113,ddd,bb,ccc,ddd,eee,fff,ggg,hhhh 20120132,aaa,bbb,ccc 20120112,aaa,bbb,ccc 20120112,xxx,bbb,ggg,ggg,333 20120112,aaa,bbb,ccc 20120112,abbd,bbb,ccc 

我如何创build一个将上面的代码拆分成多个列的macros。

只有几点

（1）我应该能够指定工作表名称，例如：

工作表（“示例”）。范围（A，A）'

（2）列和行的数量是不固定的，所以我不知道在运行vba脚本之前有多less逗号分隔值和多less行。

Answer 1

• 您可以使用InputBox()函数，并获取表单的名称与应分裂的数据。
• 然后将数据复制到变体数组中，拆分它们并创build新的拆分值数组。
• 最后将分离的数组分配回excel范围。 HTH

（请注意，源数据被直接修改，所以最后它被分隔成列，原始的未分割状态丢失，但是可以修改代码，所以原始数据不会被覆盖。

 Option Explicit Private Const sourceColumnName As String = "A" Private Const delimiter As String = "," Public Sub Splitter() ' splits one column into multiple columns Dim sourceSheetName As String Dim sourceSheet As Worksheet Dim lastRow As Long Dim uboundMax As Integer Dim result On Error GoTo SplitterErr sourceSheetName = VBA.InputBox("Enter name of the worksheet:") If sourceSheetName = "" Then _ Exit Sub Set sourceSheet = Worksheets(sourceSheetName) With sourceSheet lastRow = .Range(sourceColumnName & .rows.Count).End(xlUp).row result = SplittedValues(data:=.Range(.Cells(1, sourceColumnName), _ .Cells(lastRow, sourceColumnName)), _ partsMaxLenght:=uboundMax) If Not IsEmpty(result) Then .Range(.Cells(1, sourceColumnName), _ .Cells(lastRow, uboundMax)).value = result End If End With SplitterErr: If Err.Number <> 0 Then _ MsgBox Err.Description, vbCritical End Sub Private Function SplittedValues( _ data As Range, _ ByRef partsMaxLenght As Integer) As Variant Dim r As Integer Dim parts As Variant Dim values As Variant Dim value As Variant Dim splitted As Variant If Not IsArray(data) Then ' data consists of one cell only ReDim values(1 To 1, 1 To 1) values(1, 1) = data.value Else values = data.value End If ReDim splitted(LBound(values) To UBound(values)) For r = LBound(values) To UBound(values) value = values(r, 1) If IsEmpty(value) Then GoTo continue End If ' Split always returns zero based array so parts is zero based array parts = VBA.Split(value, delimiter) splitted(r) = parts If UBound(parts) + 1 > partsMaxLenght Then partsMaxLenght = UBound(parts) + 1 End If continue: Next r If partsMaxLenght = 0 Then Exit Function End If Dim matrix As Variant Dim c As Integer ReDim matrix(LBound(splitted) To UBound(splitted), _ LBound(splitted) To partsMaxLenght) For r = LBound(splitted) To UBound(splitted) parts = splitted(r) For c = 0 To UBound(parts) matrix(r, c + 1) = parts(c) Next c Next r SplittedValues = matrix End Function 

Answer 2

如果您以后不需要再次处理此任务，请使用以下手动方法作为解决方法：

1. 使用文本编辑器（Notepad ++）将“，”replace为“选项卡”。
2. 复制内容并粘贴到一个空的Excel工作表。

或者你可以尝试从文件导入数据（“，”作为分隔符）。

如果您需要自动脚本，请尝试以下操作：1）按Ctrl + F11打开VBA编辑器，插入一个模块。 2）点击模块，在里面添加代码如下。

 Option Explicit Public Function LastRowWithData(ByRef sht As Excel.Worksheet, Optional colName As String = "A") As Long LastRowWithData = sht.Range(colName & sht.Rows.Count).End(xlUp).Row End Function Sub SplitToColumns(ByRef sColNames As String, ByRef strSeparator As String, ByRef rngDest As Excel.Range) Dim arrColNames As Variant, i As Long arrColNames = Split(sColNames, strSeparator) For i = LBound(arrColNames) To UBound(arrColNames) rngDest.Offset(0, i).Value = arrColNames(i) Next i End Sub Sub PerformTheSplit() Dim totalRows As Long, i As Long, sColNames As String totalRows = LastRowWithData(Sheet1, "A") For i = 1 To totalRows sColNames = Sheet1.Range("A" & i).Value Call SplitToColumns(sColNames, ",", Sheet2.Range("A" & i)) Next i End Sub 

3）假设你在Sheet1中有列名：

按“Alt + F8”运行macros“PerformTheSplit”，您将在Sheet2中看到结果：

Answer 3

我只是使用Text-to-Columns向导，VBA例程允许你select表单和范围来处理，就像你上面的请求一样。

input框用于获取要处理的工作表和范围，并将默认为活动工作表和select。 这当然可以以各种方式进行修改。

然后调用内置的文本到列的function，虽然你没有这样指定，但看起来你的第一列代表YMD格式的date，所以我添加了作为一个选项 – 它应该是显而易见的如何删除或如果需要更改它。

让我知道它是如何为你工作的：

---

 Option Explicit Sub TTC_SelectWS_SelectR() Dim WS As Worksheet, R As Range Dim sMB As String Dim v On Error Resume Next Set WS = Worksheets(Application.InputBox(Prompt:="Enter Worksheet Name: ", _ Title:="Select Worksheet", _ Default:=ActiveSheet.Name, _ Type:=2)) If Err.Number <> 0 Then sMB = MsgBox("Invalid Worksheet Name", vbRetryCancel) If sMB = vbRetry Then TTC_SelectWS_SelectR Exit Sub End If On Error GoTo 0 Set R = (Application.InputBox(Prompt:="Select Range to Process: ", _ Title:="Select Range", _ Default:=Selection.Address, _ Type:=8)) Set R = WS.Range(R.Address) R.TextToColumns DataType:=xlDelimited, textqualifier:=xlTextQualifierDoubleQuote, _ consecutivedelimiter:=False, Tab:=False, semicolon:=False, comma:=True, Space:=False, _ other:=False, fieldinfo:=Array(Array(1, xlYMDFormat)) End Sub 

---