Блог

Я пытаюсь определить определенный диапазон в столбце-A и объединить две ячейки в пределах определенного диапазона и удалить пустую ячейку. Мне удалось собрать код вместе, и он отлично справляется со своей задачей. Но я не знаю, как выполнить цикл, чтобы определить следующий диапазон. Любая помощь была бы оценена.

Согласно приведенному ниже изображению и коду, сначала я нахожу и выбираю диапазон между двумя (MCS) в столбце A с условием, что, если строк больше 8 между двумя MCS. Затем я объединяю первые 2 ячейки сразу после MCS и удаляю пустую строку.

Приведенный ниже код хорошо работает для первого диапазона, но я не могу выполнить цикл для определения следующего диапазона от строки 22 до 32 и выполнить конкатенации.

Я не знаю, как выполнить цикл в столбце-A и выбрать диапазоны и объединить. Любая помощь была бы высоко оценена. Спасибо

 Sub MergeStem()
    Dim findMCS1 As Long
    Dim findMCS2 As Long
    Dim myCount As Integer
    Dim myStems As Long
    Dim mySelect As Range
    Dim c As Range

    findMCS1 = Range("A:A").Find("MCS", Range("A1")).Row
    findMCS2 = Range("A:A").Find("MCS", Range("A" amp; findMCS1)).Row

    myCount = Range("A" amp; findMCS1   1 amp; ":A" amp; findMCS2 - 1).Cells.Count
    Range("B1").Value = myCount
    MsgBox "Number of rows =" amp; myCount

    Set mySelect = Selection

    If myCount > 8 Then
        myStems = Range("A" amp; findMCS1   2 amp; ":A" amp; findMCS2 - 9).Select

        Set mySelect = Selection

        For Each c In mySelect.Cells
            If firstcell = "" Then firstcell = c.Address(bRow, bCol)
            sArgs = sArgs   c.Text   " "

            c.Value = ""
        Next
        Range(firstcell).Value = sArgs
    End If

    Columns("A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    Application.ScreenUpdating = True

End Sub
  

Вы можете попробовать это? Обычно Find было бы правильным решением, но поскольку вы удаляете строки, трудно отслеживать, какие ячейки вы нашли.

 Sub x()

Dim r As Long, n1 As Long, n2 As Long

With Range("A1", Range("A" amp; Rows.Count).End(xlUp))
    For r = .Count To 1 Step -1
        If .Cells(r).Value = "MCS" Then
            If n1 = 0 Then
                n1 = .Cells(r).Row
            Else
                n2 = .Cells(r).Row
            End If
            If n1 > 0 And n2 > 0 Then
                If n1 - n2 > 9 Then
                    .Cells(r   1).Value = .Cells(r   1).Value amp; .Cells(r   2).Value
                    '.Cells(r   2).EntireRow.Delete
                    'Call procedure to delete row 
                End If
                n1 = n2
                n2 = 0
            End If
        End If
    Next r
End With

End Sub