Цикл по объединенным ячейкам в VBA

Question

Можно ли перебрать объединенные ячейки в vba.

• У меня есть 6 слитых ячеек в диапазоне B4:B40
• Мне нужны значения в этих 6 ячейках 6 итераций только.

Answer 1

Приведенные выше ответы выглядят так, как будто вы отсортированы.

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

Когда я построил Mappit! Я понял, что когда я разработал объединенную ячейку, отчет о том, что объединенные ячейки были частью xlBlanks

Таким образом, вы можете использовать код для немедленного обнаружения объединенных ячеек, а не циклически проходить тестирование каждой ячейки для MergedCells свойство быть правдой.

Sub DetectMerged()
Dim rng1 As Range
Dim rng2 As Range
On Error Resume Next
Set rng1 = Intersect(Cells.SpecialCells(xlFormulas), Cells.SpecialCells(xlBlanks))
Set rng2 = Intersect(Cells.SpecialCells(xlConstants), Cells.SpecialCells(xlBlanks))
On Error GoTo 0
If Not rng1 Is Nothing Then MsgBox "Merged formulae cells in " & rng1.Address(0, 0)
If Not rng2 Is Nothing Then MsgBox "Merged constant cells in " & rng2.Address(0, 0)
End Sub

Answer 2

Вот первый удар по вашей проблеме:

Option Explicit

Sub loopOverCells()
    Dim rCell As Range
    Dim i As Integer

    Set rCell = [B1]
    For i = 1 To 6
        Debug.Print rCell.Address
        Set rCell = rCell.Offset(1, 0)    ' Jump 1 row down to the next cell
    Next i
End Sub

Answer 3

Немного покрепче, похожая идея:

Option Explicit

Sub ListValues()
Dim i As Long

    For i = 4 To 40 Step 6
        Debug.Print Range("B" & i).Value
    Next i

End Sub

Answer 4

Вот итерационная подпрограмма, заданная диапазоном с объединенными ячейками

      Sub IterateMerged(ByVal r As Range)

    ' You can switch these loops to iterate through rows first 
    Dim CurrentRow as Double
    Dim CurrentCol as Double
    For CurrentRow = 0 To r.Rows.Count Step 0
        For CurrentCol = 0 to r.Columns.Count Step 0

            ' You could additionally add a if statement to check if this cell is merged, to iterate only over merged cells
            ' Your code goes here
            MsgBox "I'm at: " & r.Cells(CurrentRow, CurrentCol).MergeArea.Address

            CurrentCol = CurrentCol + r.Cells(CurrentRow, CurrentCol).MergeArea.Columns.Count
        Next CurrentCol
        CurrentRow = CurrentRow + r.Cells(CurrentRow, CurrentCol).MergeArea.Rows.Count
    Next CurrentRow

End Sub