Макрос не работает, когда я «вызываю» его из другого макроса, но работает, когда я выбираю его по отдельности - PullRequest
1 голос
/ 30 марта 2020

У меня есть макрос форматирования ниже:

Sub Colour_whole_sheet()

Dim lastRow As Long
Dim lastColumn As Long

lastRow = Range("A1").End(xlDown).Row
lastColumn = Range("A3").End(xlToRight).Column

'Colour alternate rows purple / white
For Each cell In Range(Cells(1, 1), Cells(lastRow, lastColumn))
    If cell.Row Mod 2 = 1 Then
        cell.Interior.Color = RGB(242, 230, 255)
    Else
        cell.Interior.Color = RGB(255, 255, 255)
    End If
Next cell

End Sub

Он не запускается, когда я вызываю его из другого макроса, который просто:

Sub Run_macros()

[A bunch of other subs]
Call Colour_whole_sheet
[A bunch of other subs]

End Sub

Не приходит с ошибкой - он просто ничего не делает. Но когда я выбираю его отдельно, в меню «Просмотр»> «Макросы»> «Просмотр макросов»> «Выполнить» он работает нормально.

Знаете ли вы, почему это может быть?

РЕДАКТИРОВАТЬ:

Sub Colour_whole_sheet()

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Calendar")

Dim lastRow As Long
Dim lastColumn As Long

lastRow = ws.Range("A1").End(xlDown).Row
lastColumn = ws.Range("A3").End(xlToRight).Column

'Colour alternate rows purple / white
For Each cell In ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastColumn))
    If cell.Row Mod 2 = 1 Then
        cell.Interior.Color = RGB(242, 230, 255)
    Else
        cell.Interior.Color = RGB(255, 255, 255)
    End If
Next cell

End Sub

Ответы [ 2 ]

2 голосов
/ 30 марта 2020

вы можете быть после этой ревизии вашего кода

Sub Colour_whole_sheet(Optional sht As Variant)

    If IsMissing(sht) Then Set sht = ActiveSheet ' if no argument is passed assume ActiveSheet

    Dim lastRow As Long
    Dim lastColumn As Long
    Dim i As Long

    With sht ' reference passed/assumed sheet object
        lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row ' best way to get a column last used cell row index
        lastColumn = .Cells(3, .Columns.Count).End(xlToLeft).Column ' best way to get a row last used cell column index

        'Colour alternate rows purple / white
        With .Range("A1", Cells(lastRow, lastColumn)) ' reference all your range
            .Interior.Color = vbWhite ' color it white
            For i = 1 To .Rows.Count Step 2 ' loop through referenced range uneven rows
                .Rows(i).Interior.Color = RGB(242, 230, 255) ' color them with purple
            Next
        End With
    End With

End Sub

, как вы можете видеть:

  • он всегда ссылается на какой-то лист (будь то через субаргумент или быть активным)

  • это не l oop через все ячейки, но только через неровные ряды

1 голос
/ 30 марта 2020

Здесь Range("A1") не указано, на каком листе этот диапазон. Всегда укажите рабочий лист для всех ваших Range(), Cells(), Rows() и Columns() объектов.

В противном случае весьма вероятно, что ваш код выполняется не на том листе. Обратите внимание, что это применимо к всем вашим макросам (не только к этому). Убедитесь, что вы указали рабочий лист везде , или ваш код может работать случайно или не работать.

Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Sheet1") 'your sheet name here

Затем настройте следующие строки:

lastRow = ws.Range("A1").End(xlDown).Row
lastColumn = ws.Range("A3").End(xlToRight).Column

For Each cell In ws.Range(ws.Cells(1, 1), ws.Cells(lastRow, lastColumn))

Также обратите внимание что вы можете отформатировать таблицу Excel , чтобы получить чередующиеся цвета.


Дополнительные примечания:

Используемый вами метод не является надежным при поиске последней использованной строки / столбца. Лучше сделай это наоборот. Начните с самого последнего ряда и go xlUp.

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Last used row
lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column 'last used column in row 3

Также вам не нужно go через все ячейки. Циклические строки могут быть выполнены.

Dim i As Long
For i = 1 To lastRow
    If i Mod 2 = 1 Then
        ws.Rows(i).Interior.Color = RGB(242, 230, 255)
    Else
        ws.Rows(i)..Interior.Color = RGB(255, 255, 255)
    End If
Next i

или если вы не хотите раскрашивать всю строку, а только до последнего использованного столбца

ws.Cells(i, lastColumn).Interior.Color 

Обратите внимание, что раскраска каждая строка сама по себе может сильно замедлиться, если строк много. Поэтому я предлагаю собрать все четные / неровные строки в ссылке и закрасить их сразу.

lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Last used row
lastColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column 'last used 

Dim EvenRows As Range
Dim OddRows As Range

Dim i As Long
For i = 1 To lastRow
    If i Mod 2 = 1 Then
        If OddRows Is Nothing Then
            Set OddRows = ws.Rows(i)
        Else
            Set OddRows = Union(OddROws, ws.Rows(i))
        End If
    Else
        If EvenRows Is Nothing Then
            Set EvenRows = ws.Rows(i)
        Else
            Set EvenRows = Union(EvenRows, ws.Rows(i))
        End If
    End If
Next i

If Not OddRows Is Nothing Then OddRows.Interior.Color = RGB(242, 230, 255)
If Not EvenRows Is Nothing Then EvenRows.Interior.Color = RGB(255, 255, 255)
...