根据值添加列数

时间:2018-06-26 14:33:38

标签: excel vba excel-vba loops bulkinsert

当前我在Excel中具有以下数据:

USER    ||  COUNT   ||  REPEAT COUNT    ||  OTHER DETIALS IN THE ROW
a       ||  2       ||                  ||  ASD
s       ||  1       ||                  ||  SDF
d       ||  4       ||                  ||  DFG
f       ||  1       ||                  ||  FGH
d       ||  1       ||                  ||  GHJ
f       ||  1       ||                  ||  HKJ

我需要根据“计数”将行中的内容复制粘贴到新插入的行,然后插入-“重复计数”

输出数据应如下:

USER    ||  COUNT   ||  REPEAT COUNT    ||  OTHER DETIALS IN THE ROW
a       ||  2       ||  1               ||  ASD
a       ||  2       ||  2               ||  ASD
s       ||  1       ||                  ||  SDF
d       ||  4       ||  1               ||  DFG
d       ||  4       ||  2               ||  DFG
d       ||  4       ||  3               ||  DFG
d       ||  4       ||  4               ||  DFG
f       ||  1       ||                  ||  FGH
d       ||  1       ||                  ||  GHJ
f       ||  1       ||                  ||  HKJ

1 个答案:

答案 0 :(得分:0)

试试吧。更新到您指定的范围

Option Explicit
Public Sub ConvertValuesToRows()
    Dim destRange As Range, rng As Range, srcRange As Range
    Dim i As Long, RowCount As Long

    ' Update this to your source range
    With Sheet1
        Set rng = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, .Cells(1, .Columns.Count).End(xlToLeft).Column))
    End With

    With rng
        For i = .Rows.Count To 1 Step -1
            If .Cells(i, 2) > 1 Then
                RowCount = .Cells(i, 2) - 1
                .Range(.Cells(i, 1), .Cells(i, .Columns.Count)).Resize(RowCount).Insert shift:=xlDown

                Set srcRange = Range(.Cells(i, 1), .Cells(i, rng.Columns.Count))
                Set destRange = Range(srcRange, srcRange.Offset(RowCount, 0))

                srcRange.AutoFill Destination:=destRange, Type:=xlFillCopy
                .Cells(i, 3) = 1
                srcRange.Columns(3).AutoFill Destination:=destRange.Columns(3), Type:=xlFillSeries
            End If
        Next i
    End With
End Sub