Excel宏 - 逗号分隔单元格到行 [英] Excel Macro - Comma Separated Cells to Rows

问题描述

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

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

我想将其转换为：

  a 
b 
c 
d 
e 
f 
g 
h 
i 
  

我正在使用以下宏，但是我无法获取自动调整大小来执行插入，而不是覆盖单元格值。任何帮助都不胜感激。

  Sub SplitCells（）
 
 
 Dim i As Long 
 
 
 
应用程序
 
 .Calculation = xlCalculationManual 
 
 .ScreenUpdating = False 
 
 
 
 
对于i = 1至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） 
 
下一个i 
 
 
 
 .Calculation = xlCalculationAutomatic 
 
 .ScreenUpdating = True 
 
结束
 
 End Sub 
  

解决方案

这个宏将把您的数据从A列中取出，并将其提取到B列。结果如下所示，可以自由地削减我的图形表达技巧： - ）

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

我已经把它作为无损检测目的，并且由于创建新列比较容易，请填充并删除VBA中的旧列。读者的练习...

这是宏：

  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 
 
'从列A复制到列B.'
 fromCol =A
 toCol =B
 fromRow =1
 toRow =1
 
'直到列A中没有更多条目。'
 inVal = Range（fromCol + fromRow）.Value 
当inVal<> 
 
'直到所有子条目都用完为止'
当inVal<> 
范围（fromCol + fromRow）。选择
 
'提取每个子条目'
 commaPos = InStr（1，inVal，，）
虽然逗号<> 0 
 
'并写入输出列'
 outVal = Left（inVal，commaPos  -  1）
范围（toCol + toRow）。选择
范围（toCol + toRow）.Value = outVal 
 toRow = Mid（Str（Val（toRow）+ 1），2）
 
'删除该子条目'
 inVal = Mid （inVal，commaPos + 1）
 While Left（inVal，1）=
 inVal = Mid（inVal，2）
 Wend 
 commaPos = InStr（1，inVal， 
范围（toCol + toRow）。选择
范围（$）
 Wend 
 
'获取最后一个子条目（toCol + toRow）.Value = inVal 
 toRow = Mid（Str（Val（toRow）+ 1），2）
 inVal =
 Wend 
 
 '进入下一个来源行'
 fromRow = Mid（Str（Val（fromRow）+ 1），2）
范围（fromCol + fromRow）。选择
 inVal = Range（fromCol + fromRow）.Value 
 Wend 
 End Sub 
  

I have have the following data in excel:

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

with each row, representing a row and in one cell.

I would like to convert it to:

a
b
c
d
e
f
g
h
i

I am using the following macro, but I can't get the autosize to do an insert, instead of overriding the cell values. Any help is appreciated.

    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

解决方案

This macro will take your data from column A and "extract" it to column B. The results are shown below, feel free to cower at my graphical presentation skills :-)

    <- A ->   <- B ->
1   a, b, c   a
2   d         b
3   e         c
4   f, g      d
5   h         e
6   i         f
7             g
8             h
9             i

I've left it as non-destructive for testing purposes, and since it's relatively easy to create a new column, populate it and delete the old column in VBA. An exercise for the reader...

Here is the macro:

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

这篇关于Excel宏 - 逗号分隔单元格到行的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！