Вставка новой строки между множеством сгруппированных строк

Question

Я хотел бы знать, как я могу, используя vba, добиться вставки новой строки в объединенный и групповой набор строк. На снимке экрана ниже я хочу вставить новую строку, когда условие, соответствующее имени в А4, выполнено. Происходит следующее: создается новая строка, но группировка строк и объединенная ячейка более не точны.

For Each key In sRemovedStoriesForTaskTracker.Keys
    Debug.Print key & "::" & sRemovedStoriesForTaskTracker(key)
    sJQL = "project=SISBTXTRPR AND issuetype=sub-task AND cf[12272]  = " & sRemovedStoriesForTaskTracker(key) & " order by assignee asc"
    sURL = sJIRAInstance & "/rest/api/latest/search?jql=" & sJQL
    Set JSONObjRemovedTasks = ConnectToJIRA(sURL)

    i = 1
    While i <= JSONObjRemovedTasks("total")

        For Each c In Range("A1:A300")
            If Trim(c.Value) Like JSONObjRemovedTasks("issues")(i)("fields")("assignee")("displayName") Then 
                c.EntireRow.Insert
                c.Offset(0, 1).Value = i 
                Exit For
            End If
        Next c
    Wend
Next 

Доработанный код, который исправил проблему

Я смог настроить большую часть кода Самуила, приведенного ниже (полная заслуга ему), и вот что я придумал:

For Each key In sRemovedStoriesForTaskTracker.Keys
    Debug.Print key & "::" & sRemovedStoriesForTaskTracker(key)
    sJQL = "project=SISBTXTRPR AND issuetype=sub-task AND cf[12272]  = " & sRemovedStoriesForTaskTracker(key) & " order by assignee asc"
    sURL = sJIRAInstance & "/rest/api/latest/search?jql=" & sJQL
    Set JSONObjRemovedTasks = ConnectToJIRA(sURL)

    i = 1
    While i <= JSONObjRemovedTasks("total")
        For Each c In Range("A1:A300")
            If Trim(c.Value) Like JSONObjRemovedTasks("issues")(i)("fields")("assignee")("displayName") Then
                MergedCellsRowCount = Range(c.Address).MergeArea.Rows.Count
                Worksheets("Task Tracker").Range("A" & Split(c.Address, "$")(2) + MergedCellsRowCount).EntireRow.Insert
                Worksheets("Task Tracker").Range("A" & Split(c.Address, "$")(2) + MergedCellsRowCount).Offset(0, 2).Value = "Success"
                Worksheets("Task Tracker").Range(Cells(c.Row, 1), Cells((Split(c.Address, "$")(2) + MergedCellsRowCount), 1)).Merge
                Exit For
            End If
        Next c
        i = i + 1
    Wend
Next

Answer 1

Поскольку у меня нет доступа к вашим исходным данным и т. Д., Я создал новую книгу с именами по умолчанию для всех листов и изменил некоторые вещи на «тестовые» данные, которые дали ожидаемые результаты - я изменил код обратно к вашему оригиналу с обновлениями для слияния клеток.

(код теста, который я использовал, находится в конце ответа).

Dim MergedCellsRowCount As Long

For Each c In Range("A1:A300")
    If Trim(c.Value) Like JSONObjRemovedTasks("issues")(i)("fields")("assignee")("displayName") Then 
        c.EntireRow.Insert
        c.Offset(-1, 1).Value = i 'the -1 inserts it to the new row (which is created above the "c.Row"). 
        Range(Cells(c.Row - 1, 1), Cells(c.Row, 1)).Merge
        MergedCellsRowCount = Range(c.Address).MergeArea.Rows.Count
        Range("A" & c.Row & ":A" & c.Row + MergedCellsRowCount - 1).Rows.Ungroup
        Range("A" & c.Row & ":A" & c.Row + MergedCellsRowCount - 1).Rows.Group
        Exit For
    End If
Next c

Поскольку вы только опубликовали фрагмент из вашего кода, я не уверен, что вы ссылаетесь на какой-либо конкретный лист c или рабочую книгу в этом коде, поэтому я не указал никаких объектов листа.

Если вы еще этого не сделали , вы должны добавить объекты и свойства в Range(Cells(c.Row - 1, 1), Cells(c.Row, 2)).Merge к объекту Sheet (например, Sheet1 или Sheets("SheetName"), чтобы предотвратить непредвиденное такие результаты, как код, ссылающийся на неправильный лист.

Например:

Sheet1.Range(Sheet1.Cells(c.Row - 1, 1), Sheet1.Cells(c.Row, 2)).Merge

ИЛИ Вы можете обернуть его в With...End Вот так:

With Sheet1
    .Range(.Cells(c.Row - 1, 1), .Cells(c.Row, 1)).Merge`
End With

---

Вот несколько скриншотов с тестовыми данными и результатом выполнения кода (см. ниже используемый тестовый код) :

Данные испытаний:

Результат:

Используемый тестовый код:

Sub TestInsertNewRowAndMerge()

Dim MergedCellsRowCount As Long

For Each c In Range("A1:A300")
    If Trim(c.Value) Like "test" Then
        c.EntireRow.Insert
        c.Offset(-1, 1).Value = "Success"
        Sheet1.Range(Sheet1.Cells(c.Row - 1, 1), Sheet1.Cells(c.Row, 2)).Merge
        MergedCellsRowCount = Range(c.Address).MergeArea.Rows.Count
        Range("A" & c.Row & ":A" & c.Row + MergedCellsRowCount - 1).Rows.Ungroup
        Range("A" & c.Row & ":A" & c.Row + MergedCellsRowCount - 1).Rows.Group
        Exit For
    End If
Next c

End Sub