Sub GetKeyColumns20000() Dim arr() As String ReDim arr(5) Dim arri() As String ReDim arri(5) arr(0) = "Дата" arr(1) = "Приход" arr(2) = "Сумма2" arr(3) = "Расход" arr(4) = "Сумма" i = -1 For Each a In arr i = i + 1 For Each r In Range("A1:L30") If r.Value = a Then arri(i) = r.Column Next Next 'После того как данные нашли, проверяем объдиненные ячейки. Индексы хранятся уже arri i = -1 For Each a In arri i = i + 1 For Each r In Range("A1:L30") r.Select If r.MergeCells = True And r.Value "" Then i2 = -1 For Each a1 In arr i2 = i2 + 1 If r.Value = a1 Then GoTo NEXT_ Next NEXT_: StartColumn = Selection.Column EndColumn = Selection.Column + Selection.Columns.Count - 1 StartRow = Selection.Row EndRow = Cells.SpecialCells(xlLastCell).Row For i = StartRow To EndRow For j = StartColumn To EndColumn If IsNumeric(Cells(i, j).Value) And Cells(i, j).Value "" Then arri(i2) = j End If Next j Next i End If Next Next For Each a In arri Debug.Print a Next End Sub