Excelmacros – 逗号分隔单元格到行

我在Excel中有以下数据：

a, b, c d e f, g h i 

每行代表一行，并在一个单元格中。

我想将其转换为：

 a b c d e f g h i 

我正在使用下面的macros，但我不能让autosize做插入，而不是覆盖单元格的值。 任何帮助表示赞赏。

  Sub SplitCells() Dim i As Long With Application .Calculation = xlCalculationManual .ScreenUpdating = False For i = 1 To Selection.Rows.Count Dim splitValues As Variant splitValues = split(Selection.Rows(i).Value, ",") Selection.Rows(i).Resize(UBound(splitValues) - LBound(splitValues) + 1).Value = Application.Transpose(splitValues) Next i .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub 

Answer 1

这个macros将把你的数据从列A中“提取”到列B.结果如下所示，随意在我的graphics化表示技巧上缩小:-)

  <- A -> <- B -> 1 a, b, ca 2 db 3 ec 4 f, gd 5 he 6 if 7 g 8 h 9 i 

为了testing的目的，我将它保留为非破坏性的，因为创build新列相对容易，请填充它并删除VBA中的旧列。 为读者做的练习

这是macros：

 Option Explicit Sub Macro1() Dim fromCol As String Dim toCol As String Dim fromRow As String Dim toRow As String Dim inVal As String Dim outVal As String Dim commaPos As Integer ' Copy from column A to column B.' fromCol = "A" toCol = "B" fromRow = "1" toRow = "1" ' Go until no more entries in column A.' inVal = Range(fromCol + fromRow).Value While inVal <> "" ' Go until all sub-entries used up.' While inVal <> "" Range(fromCol + fromRow).Select ' Extract each subentry.' commaPos = InStr(1, inVal, ",") While commaPos <> 0 ' and write to output column.' outVal = Left(inVal, commaPos - 1) Range(toCol + toRow).Select Range(toCol + toRow).Value = outVal toRow = Mid(Str(Val(toRow) + 1), 2) ' Remove that sub-entry.' inVal = Mid(inVal, commaPos + 1) While Left(inVal, 1) = " " inVal = Mid(inVal, 2) Wend commaPos = InStr(1, inVal, ",") Wend ' Get last sub-entry (or full entry if no commas).' Range(toCol + toRow).Select Range(toCol + toRow).Value = inVal toRow = Mid(Str(Val(toRow) + 1), 2) inVal = "" Wend ' Advance to next source row.' fromRow = Mid(Str(Val(fromRow) + 1), 2) Range(fromCol + fromRow).Select inVal = Range(fromCol + fromRow).Value Wend End Sub 

Answer 2

这是未经testing的，但这是我多次使用的algorithm模式。 这已经有一段时间了，所以不要完全相信这个语法。

 sub SplitCells() Dim c as Range ' iterator for cells in Selection dim r as Range ' to hold the range which is the first cell in Selection Dim r2 as Range ' variable range for single cell which is the target for inserting the result Dim a() a Variant ' array of variants to hold each cell's value after it's split Dim b() as Variant ' array of variants to hold the accumulation of values to spread into the destination Dim v ar Variant ' variant to iterate through b for insertion Dim i as Integer ' cumulative offset from top of destination range while inserting For each c in Selection.Cells a = Split(Replace(c.Text, ",", "")) ' will split on whitespace for each v in a b.Add v next v next c ' now you have a new array with the full set of values ' insert them a row at a time using Range.Offset i = 0 Set r = Selection.Cells(0) For Each v in b Set r2 = r.Offset(1, 0) r2.Value = vi = i + 1 next v End Sub 

Answer 3

我不是很擅长Excel VBA，但这工作（不知何故!!）

 Sub arrange() ' get the current range from the sheet curr_range = ActiveSheet.Range("A1:A6") ' for each cell in that range ... For Each Row In curr_range ' ...put the contents into an array arr = Split(Row, ",") ' for each cell in that array ... For Each cell In arr ' ...output it into a string output_str = output_str & "," & cell Next cell Next Row ' remove spaces output_str = Replace(output_str, " ", "") ' remove left , output_str = Right(output_str, Len(output_str) - 1) ' make it into an array output_arr = Split(output_str, ",") ' populate the sheet back ActiveSheet.Range("A:A").Value = Application.WorksheetFunction.Transpose(output_arr) End Sub