excel - Excel VBA循环并查找特定范围并连接2个单元格值并删除空单元格

Question

我正在尝试识别 A 列中的特定范围并连接特定范围内的两个单元格并删除空单元格。我已经成功地将代码放在一起，并且做得很好。但是，我不知道如何循环它来识别下一个范围。任何帮助，将不胜感激。

根据下面的图像和代码，首先，我在 A 列中查找并选择两个（MCS）之间的范围，条件是，如果两个 MCS 之间的行数超过 8。然后我在 MCS 之后立即连接前 2 个单元格并删除空行。

下面的代码适用于第一个范围，但我无法循环识别从第 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" & findMCS1)).Row

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

    Set mySelect = Selection

    If myCount > 8 Then
        myStems = Range("A" & findMCS1 + 2 & ":A" & 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

标签： excelvba

Answer 1

你能试试这个吗？通常，Find这是要走的路，但是因为您要删除行，所以很难跟踪您找到了哪些单元格。

Sub x()

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

With Range("A1", Range("A" & 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 & .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