首页 文章

Excel-向下移动多个数据单元格并在下面插入行

提问于
浏览 次
0

我有一个包含1K记录和10列的Excel 2007工作表 . 问题是，一个单元格包含多个数据，我需要向下移动到每个单元格中，我需要插入新行，因为向下移动数据会破坏其余的行和重叠 . 是他们的VBA代码或宏进程这样做 . 请帮忙 .

这是excel表 .

Category | Desciption       | Sizes      | Price
------   | ------
car      | Car Description  |  123  - M  | $20
                               1245 - XL | $50
                               1243 - XXL| $55
Car2     | Car2 Description |  123  - M  | $20
                               1245 - XL | $50
                               1243 - XXL| $55

我希望它清楚我想要实现的目标 . SIzes列数据在一个单元格上，我需要在插入行时将它们向下移动，以免干扰下面的其余数据 .

非常感谢 . 哈龙

excel vba macros

1 回答

  • 1

    你可以尝试和改编（见评论）这段代码：

    Option Explicit

Sub main()
    Dim iRow As Long, nRows As Long, nData As Long
    Dim arr As Variant

    With Worksheets("data").Columns("C") '<--| assuming "Sizes" are in column "C"
        nRows = .Cells(.Rows.Count, 1).End(xlUp).row '<--| get column "C" last non empty row
        For iRow = nRows To 2 Step -1 '<--| loop through column "C" rows from the last one upwards
            With .Cells(iRow) '<--| reference column "C" current cell
                arr = Split(.Value, vbLf) '<--| try and split cell content into an array with "linefeed" character as delimeter
                nData = UBound(arr) + 1 '<--| count array items (Split generates 0-based array, so a 1-element array upperbound is 0)
                If nData > 1 Then '<--| if there are more than 1 ...
                    .EntireRow.Offset(1).Resize(nData - 1).Insert '<--| insert rows beneath current cell
                    .Resize(nData).Value = Application.Transpose(arr) '<--| fill current cell and new ones beneath it with array values (you have to transpose it, since array is a 1-row array while you're writing into a 1-column range)
                    .Offset(, 1).Resize(nData).Value = Application.Transpose(Split(.Offset(, 1).Value, vbLf)) '<--| do the same filling with adjacent cell
                End If
            End With
        Next iRow
    End With
End Sub
    回复于

相关问题