[решено] Выбор нескольких ячеек экселя с помощью переменной в макросе.

Компьютерный форум OSzone.net (http://forum.oszone.net/index.php)

- Программирование и базы данных (http://forum.oszone.net/forumdisplay.php?f=21)

Выбор нескольких ячеек экселя с помощью переменной в макросе.

Здравствуйте.

Есть рабочий скрипт.

Код:

Sub Unmerge()

'

' Unmerge Macro

'

'



   Dim rowCount As Long



          For rowCount = 2 To 2200

          ActiveSheet.Range("A" & rowCount).Select

            With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

              Selection.Unmerge

        Next rowCount

For rowCount = 2 To 2200

          ActiveSheet.Range("B" & rowCount).Select

            With Selection

        .HorizontalAlignment = xlGeneral

        .VerticalAlignment = xlCenter

        .WrapText = True

        .Orientation = 0

        .AddIndent = False

        .IndentLevel = 0

        .ShrinkToFit = False

        .ReadingOrder = xlContext

        .MergeCells = True

    End With

    Selection.Unmerge

    Next rowCount

    ActiveSheet.Range("$A$1:$B$2171").AutoFilter Field:=1, Criteria1:="="

    Rows("3:2171").Select

    Selection.Delete Shift:=xlUp

    ActiveSheet.Range("$A$1:$B$1086").AutoFilter Field:=1

    Range("D1").Select

    End Sub

Хотелось бы вместо двух проходов (сперва столбец А, потом столбец В) делать один.
К сожалению, не смог разобраться, как это прописать.
На

Код:

ActiveSheet.Range("A" & rowCount: "В" & rowCount).Select

и всяческие вариации на эту тему ругается компилятор.
Что я делаю не так? :)

Цитата:

Цитата subuday77

Есть рабочий скрипт. »

Ужас-ужас-ужас. Надо раз и навсегда забыть про .Select() (потому обязательно корректировать код после макрорекордера).

Цитата:

Цитата subuday77

Что я делаю не так? »

Вы делаете «не так» следующее:

не даёте описание задачи;
не даёте описание того, что делает (или что должен был бы делать) код;
не упаковываете в архив образец Рабочей книги, для которой предназначен выложенный код, и не прикладываете его к сообщению.

Я вот смотрю на код и думаю — что он, собственно, делает и зачем? Вам действительно нужно всё вот это:

Код:

        With Selection

            .HorizontalAlignment = xlGeneral

            .VerticalAlignment = xlCenter

            .WrapText = True

            .Orientation = 0

            .AddIndent = False

            .IndentLevel = 0

            .ShrinkToFit = False

            .ReadingOrder = xlContext

            .MergeCells = True

        End With

        

        Selection.Unmerge

или это — как было в макрорекордере записано, так и осталось?! Зачем нужно сначала .MergeCells = True и тут же — .Unmerge()?! Не нравится мне и жёстко привязанная адресация вида .Range("$A$1:$B$2171"), .Range("$A$1:$B$1086"). Впрочем, дело Ваше.

Убрал ненужный .Select(), остальное оставил как было.

Код:

Option Explicit



Sub Unmerge()

    Dim iRowCount As Long

    Dim iColumnCount As Long

    

    For iColumnCount = 1 To 2

        For iRowCount = 2 To 2200

            With ActiveSheet.Cells.Cells(iRowCount, iColumnCount)

                .HorizontalAlignment = xlGeneral

                .VerticalAlignment = xlCenter

                .WrapText = True

                .Orientation = 0

                .AddIndent = False

                .IndentLevel = 0

                .ShrinkToFit = False

                .ReadingOrder = xlContext

                .MergeCells = True

                

                .Unmerge

            End With

        Next iRowCount

    Next iColumnCount

    

    ActiveSheet.Range("$A$1:$B$2171").AutoFilter Field:=1, Criteria1:="="

    Rows("3:2171").Select

    Selection.Delete Shift:=xlUp

    ActiveSheet.Range("$A$1:$B$1086").AutoFilter Field:=1

    Range("D1").Select

End Sub

subuday77, я серьёзно спрашиваю по поводу:

Цитата:

Цитата Iska

что он, собственно, делает и зачем? Вам действительно нужно всё вот это: »

ибо, если окажется, что Вам действительно нужно только рассплитить ячейки, то всё укладывается в одну строку:

Код:

    With ActiveSheet

        .Range(.Cells.Cells(2, 1), .Cells.Cells(2200, 2)).Unmerge

    End With

вместо перебора кучи ячеек диапазона по одной.

Спасибо.
Про Select() я в курсе. Но грешен. Я ещё и <шопотом, оглядываясь> goto в батниках использую.
Но в целом, да, как записал, так и работает. Ну, почти. В напрямую записанном виде он не работал, по причине превышения 64 битного размера. :)
Пришлось слегка допилить.
Ваш способ очень хорош, более того, позволяет более гибко обработать лист.
Но в нём всё равно 2 прохода по листу.

И всё таки, можно как-то скомбинировать буквы и переменные?
Допустим, даже без Select.

Код:

 For iRowCount = 2 To 2200

            With ActiveSheet.Cells.Cells("A" & iRowCount : "B" & iRowCount)

           .MergeCells = false

 End With

        Next iRowCount

Вот такое что-нибудь?

Цитата:

With ActiveSheet
.Range(.Cells.Cells(2, 1), .Cells.Cells(2200, 2)).Unmerge
End With

А что так можно было?!

А он не угробит содержимое всех ячеек, кроме верхней?
UPD. Проверил. Нет, не угробит. :)

Цитата Iska:
что он, собственно, делает и зачем? »
Расскажу.
Некое существо, ещё более криворукое, чем я, собрало кучу эксель листов копипастом с сайта.
Всё ничего, но данные выглядят так:
http://forum.oszone.net/attachment.p...1&d=1535471448
Их очень много.
И чтобы привести всё это в божеский вид, пришлось срочно осваивать VBS.
Часа за два сваял что-то, что разцепляет ячейки, не удаляя при этом содержимое, а потом сносит пустые строки.
Как-то так.

Цитата:

Цитата subuday77

Я ещё и <шопотом, оглядываясь> goto в батниках использую. »

Ну, тут, как бы, никуда не деться.

Цитата:

Цитата subuday77

И всё таки, можно как-то скомбинировать буквы и переменные? »

Комбинировать можно, только не буквы, а диапазоны (например, по объединять по Union() (Application.Union Method (Excel) | Microsoft Docs) или брать пересечение по .Intersect() (Application.Intersect Method (Excel) | Microsoft Docs)). Но мы можеи просто взять диапазон зараз:

Код:

    With ActiveSheet

        .Range(.Cells.Cells(2, 1), .Cells.Cells(2200, 2)).Unmerge

    End With

указывая в методе .Range() левую верхнюю ячейку и правую нижнюю ячейку диапазона. Причём, поскольку в методе .Range() требуется указание объектов типа Range, мы можем вместо метода .Cells() и цифр строки и столбца использовать буквенно-цифоровую адресацию, например:

Код:

    With ActiveSheet

        .Range(.Range("A2"), .Range("B2200")).Unmerge

    End With

Цитата:

Цитата subuday77

А что так можно было?! »

Конечно. Я потому и пишу, что обычно требуется сделать:

Скрытый текст

Цитата:

Цитата Iska

Вы делаете «не так» следующее:

не даёте описание задачи;
не даёте описание того, что делает (или что должен был бы делать) код;
не упаковываете в архив образец Рабочей книги, для которой предназначен выложенный код, и не прикладываете его к сообщению.

потому как задача может быть решена совсем другим способом, может не нуждаться в выбранном решении и т.п.

Цитата:

Цитата subuday77

А он не угробит содержимое всех ячеек, кроме верхней? »

А как? Это при объединении теряются значения всех объединённых ячеек, кроме самой верхней левой, но мы же тут разъединяем их, а не объединяем.

Цитата:

Цитата subuday77

Расскажу.
Некое существо, ещё более криворукое, чем я, собрало кучу эксель листов копипастом с сайта.
Всё ничего, но данные выглядят так:
http://forum.oszone.net/attachment.p...1&d=1535471448
Их очень много.
И чтобы привести всё это в божеский вид, пришлось срочно осваивать VBS.
Часа за два сваял что-то, что разцепляет ячейки, не удаляя при этом содержимое, а потом сносит пустые строки.
Как-то так. »

subuday77, спасибо, ясно. Ну, тогда, значится, для однократного применения и Ваш код более чем гож, даже с прямым указанием адресации (разве что отрабатывать будет достаточно долго).

Цитата:

Цитата subuday77

а потом сносит пустые строки. »

То есть, вот этот код у Вас:

Цитата:

Цитата subuday77

Код:

    ActiveSheet.Range("$A$1:$B$2171").AutoFilter Field:=1, Criteria1:="="

    Rows("3:2171").Select

    Selection.Delete Shift:=xlUp

    ActiveSheet.Range("$A$1:$B$1086").AutoFilter Field:=1

    Range("D1").Select

предназначен для удаления пустых строк?

Вот, привёл вот к такому виду:

Код:

Sub Unmerge()

'

' Unmerge Macro

'

'



  With ActiveSheet

    .Range("$A$2:$B$2200").Unmerge

    .Range("$A:$B").AutoFilter Field:=1, Criteria1:="="

     Rows("2:2200").Select

     Selection.Delete Shift:=xlUp

    .Range("$A:$B").AutoFilter Field:=1

    .Range("D1").Select

  End With

End Sub

Всё работает.
Ещё раз спасибо! :up:

subuday77, удалить можно ещё так:

Код:

    Dim objRange As Variant

    …

    

    For Each objRange In ActiveSheet.Range("A2:A2200").SpecialCells(xlCellTypeBlanks).EntireRow.Areas

        objRange.Delete

    Next objRange

Берём в диапазоне .Range("A2:A2200") все пустые ячейки, берём целые строки от них, перебираем и удаляем каждую из отдельных областей полученного диапазона.

Почему именно .Range("A2:A2200"), а не .Range("A2:B2200")? Потому что Вы фильтруете по Field == 1.