Выделить несмежные строки макросом VBA

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

Выделить несмежные строки макросом VBA (Макросы/Sub)

Xpert

Дата: Вторник, 20.06.2023, 20:13 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Приветствую вас, дамы и господа!
Столкнулся с необходимостью изменения высоты строк, содержащих определённый текст.
Строки несмежные.

Нижеуказанный макрос, записанный макрорекордером(!) не работает, выдавая ошибку "Run-time error '1004': Method 'Range' of object'_Global' failed."
[vba]

Код

Sub Макрос5()
'
' Макрос5 Макрос
'

'
    Range("2:2,6:6,10:10,14:14").Select
    Range("A14").Activate
    Selection.RowHeight = 22.5
    Range("B16").Select
End Sub

[/vba]

Большая просьба к знатокам пояснить, почему не работает макрос, и есть ли какие-то варианты решения моей задачи?

Спасибо.

Ответить

WowGun

Дата: Вторник, 20.06.2023, 20:28 | Сообщение № 2

Группа: Проверенные

Ранг: Новичок

Сообщений: 45

Репутация: 19 ±

Замечаний: 0% ±

Excel 2016

Добрый день.
Во вновь созданном файле макрос отрабатывает без ошибок.

К сообщению приложен файл: 4566763.jpg (14.8 Kb)

УЧИТЕСЬ ... спрашивать.

Ответить

i691198

Дата: Вторник, 20.06.2023, 22:04 | Сообщение № 3

Группа: Проверенные

Ранг: Обитатель

Сообщений: 324

Репутация: 104 ±

Замечаний: 0% ±

Совсем не обязательно указывать все строки целиком, достаточно по одной ячейке из строки. Весь код в одну строку.
[vba]

Код

Range("A2,A6,A10,A14").RowHeight = 22.5

[/vba]

Ответить

Xpert

Дата: Среда, 21.06.2023, 07:01 | Сообщение № 4

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

WowGun, да, и правда работает. Что было. не пойму...

i691198, спасибо!

Ответить

Xpert

Дата: Среда, 21.06.2023, 07:14 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Уважаемые форумчане!
Снова прошу помощи.

Поскольку строк, у которых нужно изменять размер, довольно много, номенклатура часто меняется, и вручную прописывать диапазон нецелесообразно, соорудил такой код:
Искомые наименования находятся в столбце "B".
[vba]

Код

Sub test7()
With ActiveSheet
   Dim i&, a(), s As String, x(), n&, j&
   With .Range("B1", .Cells(Rows.Count, "B").End(xlUp))
   a = WorksheetFunction.Transpose(.Value)
   End With
   For i = LBound(a) To UBound(a)
   Dim sm As Long
   If InStr(a(i), "Pineapple") Then
   sm = sm + 1
   End If
   Next i
   ReDim x(1 To sm)
       For i = LBound(a) To UBound(a)
           If InStr(a(i), "Pineapple") Then
           n = n + 1
           x(n) = "B" & i
           End If
       Next
       s = Join(x, ",")
       .Range(s).RowHeight = 22.5
End With
End Sub

[/vba]
Но снова ошибка в строке ".Range(s).RowHeight = 22.5"....
Пишет "Run-time error '1004': Application-defined or object-defined error".

Сообщение отредактировал Xpert - Среда, 21.06.2023, 07:15

Ответить

Gustav

Дата: Среда, 21.06.2023, 07:44 | Сообщение № 6

Группа: Админы

Ранг: Участник клуба

Сообщений: 2790

Репутация: 1154 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Возможно, на длину s есть какое-то ограничение. Типа 256 символов. Проверьте.

Если будет критично, можно переделать алгоритм на сбор составного диапазона через Union.

МОИ: Ник, Tip box: 41001663842605

Ответить

Xpert

Дата: Среда, 21.06.2023, 08:05 | Сообщение № 7

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Gustav, здравствуйте.

Да, Вы правы, длина строки при нынешнем количестве записей составляет 931 .

Как можно это обойти?

Ответить

Pelena

Дата: Среда, 21.06.2023, 08:57 | Сообщение № 8

Группа: Админы

Ранг: Местный житель

Сообщений: 19392

Репутация: 4537 ±

Замечаний: ±

Excel 365 & Mac Excel

Цитата Gustav, 21.06.2023 в 07:44, в сообщении № 6 (

)

сбор составного диапазона через Union

[vba]

Код

Sub test7()
    With ActiveSheet
        Dim i&, a, rg As Range
        a = .Range("B1", .Cells(.Rows.Count, "B").End(xlUp)).Value
        For i = 1 To UBound(a)
            If InStr(a(i, 1), "Pineapple") Then
                If rg Is Nothing Then Set rg = .Rows(i) Else Set rg = Union(rg, .Rows(i))
            End If
        Next i
        If Not rg Is Nothing Then rg.EntireRow.RowHeight = 22.5
    End With
End Sub

[/vba]

"Черт возьми, Холмс! Но как??!!"
Ю-money 41001765434816

Ответить

Xpert

Дата: Среда, 21.06.2023, 11:13 | Сообщение № 9

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 117

Репутация: 0 ±

Замечаний: 0% ±

Excel 2013

Pelena, Елена, спасибо большое!

Ответить

Выделить несмежные строки макросом VBA (Макросы/Sub)

Страница 1 из 1
1