Добавить количество столбцов на основе значения - PullRequest
0 голосов
/ 26 июня 2018

В настоящее время у меня есть следующие данные в 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

Требуется, чтобы содержимое строки было скопировано, вставлено во вновь вставленную строку на основе "count" и вставлено - "счетчик повторов"

Выходные данные должны быть следующими:

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 голосов
/ 26 июня 2018

Дайте это. Обновите свой диапазон, где указано

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
Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...