Макрос Excel Visual Basic для объединения ячеек в выбранной области

Question

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

На данный момент у меня это:

Sub mergemainbody()    
    lrow = ActiveSheet.UsedRange.Rows.Count - 2        
    On Error Resume Next  
    Application.DisplayAlerts = False  
    For col = 1 To 50  
       For Each ar In Cells(3, col).Resize(lrow).SpecialCells  (xlCellTypeBlanks).Areas  
          ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge  
       Next  
    Next  
 End Sub

Это работает на всем листе, но я хочу, чтобы макрос применялся только к выбранной области. Однако простое изменение For col = 1 to 50 на For Each cell In Selection заставляет макрос, по-видимому, ничего не делать.

Пример данных:

Heading | Heading   | Heading   | Heading   |      
1456262 | 270520    | 574038    | 583059    |    
Words   | --------- | --------- | --------- |  
586048  | --------- | --------- | --------- |        
Words   | 694574    | 856738    | 068438    |

Где --- показывает, что ячейка пуста.

vba excel macros

0

Elin B 6 Сен 2016 в 17:49

Answer 1

Вот примерный способ объединить ваш выбор, как вы просили. Обратите внимание, что это не сработает так, как вы предполагали, если в первой ячейке нет значения.

Sub MergeDown()
    Dim rng As Range, r As Range
    Dim i As Integer

    Set rng = Selection
    For Each r In rng
        If r.Value <> "" Then
            i = 1
            While r.Offset(i, 0).Value = "" And Not Intersect(r.Offset(i, 0), rng) Is Nothing
                i = i + 1
            Wend
            r.Resize(i, 1).Merge
        End If
    Next r
End Sub

1

CallumDA 6 Сен 2016 в 15:28

Answer 2

Я считаю, что ваша проблема в том, что переменные никогда не объявлялись, поэтому VBA догадывается, что они из себя представляют. Используйте этот код и посмотрите, не возникнут ли ошибки:

Option Explicit
Sub mergemainbody()
Dim selRange As Range
Dim lRow    As Long
Dim ar As Range, col As Range

Set selRange = Selection
lRow = selRange.Rows.Count - 2    ' Why -2?
'On Error Resume Next
Application.DisplayAlerts = False

For Each col In selRange.Columns
    For Each ar In Cells(3, col.Column).Resize(lRow).SpecialCells(xlCellTypeBlanks).Areas
        ar.Resize(ar.Rows.Count + 1).Offset(-1).Merge
    Next
Next col
End Sub

Единственная ошибка, которую он может выдать, - это ошибка после того, как больше нет SpecialCells(xlCellTypeBLanks), что означает, что он успешно прошел по всем ячейкам.

0

BruceWayne 6 Сен 2016 в 15:27

Answer 3

Выньте «При ошибке возобновить следующий», это верный способ скрыть любые ошибки ..

-2

Joe Bourne 6 Сен 2016 в 14:56

Answer 4

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

После изоляции строки 3 от последней использованной строки в блоке данных, исходящей из A1 с помощью Свойство Range.CurrentRegion и Range.Resize / Range.Offset свойства, используйте метод Range.SpecialCells с xlCellTypeBlanks . При циклическом переходе по свойству Range.Areas изменяйте размер и смещение перед слиянием.

Dim c As Long, a As Long
With ActiveSheet
    'work on the block of data radiating out from A1
    With .Cells(1, 1).CurrentRegion
        'move off the header row and first row of data
        With .Resize(.Rows.Count - 2, .Columns.Count).Offset(2, 0)
            'work through the columns
            For c = 1 To .Columns.Count
                'locate the blank cells in groups (aka Areas)
                With .Columns(c).Cells.SpecialCells(xlCellTypeBlanks)
                    'cycle through the areas (blank cell groups)
                    For a = 1 To .Areas.Count
                        'work with each Area in turn
                        With .Areas(a).Cells
                            'resize one row larger and offset one row up
                            .Resize(.Rows.Count + 1, 1).Offset(-1, 0).Merge
                            'optionally center the value in the newly merged cells
                            .VerticalAlignment = xlCenter
                        End With
                    Next a
                End With
            Next c
        End With
    End With
End With

1

user4039065user4039065 6 Сен 2016 в 15:39

Макрос Excel Visual Basic для объединения ячеек в выбранной области

4 ответа

Похожие вопросы

Связанные вопросы

Новые вопросы

vba