Блог

Я пытаюсь добавить в свой проект раздел vba, который присваивает серийные номера цветному диапазону первого столбца, однако безуспешно. Я придумал следующий код:

 Private Sub CommandButton1_Click()

    On Error GoTo ErrorHandler
    
    Dim serial, i, EndRow, StartRow As Integer
    Dim row As Range, cell As Range
    
    'Discover the data starting and end rows
    i = 1
    serial = 1
    StartRow = 1
    EndRow = 1

    'Check the first cell of each row for the data-start background colour
    For Each row In ActiveSheet.UsedRange.Rows
        Cells(row.row, 1).Select
        If i < 3 Then
            If Hex(cell.Interior.Color) = "47AD70" And i = 1 Then
                Cells(row.row, 1).Value = Abs(serial)
                StartRow = serial
                serial = serial   1
                i = 2
            ElseIf Hex(cell.Interior.Color) = "47AD70" And iRow = 2 Then
                Cells(row.row, 1).Value = Abs(serial)
                serial = serial   1
            ElseIf Hex(cell.Interior.Color) <> "47AD70" And iRow = 2 Then
                EndRow = serial - 1
                i = 3
            End If
        End If
    Next row
    
ErrorHandler:
    If Err.Number <> 0 Then
        Msg = "Error # " amp; Str(Err.Number) amp; " was generated by " _
         amp; Err.Source amp; Chr(13) amp; "Error Line: " amp; Erl amp; Chr(13) amp; Err.Description
        MsgBox Msg, , "Error", Err.HelpFile, Err.HelpContext
    End If
End Sub
  

Переменная i используется в качестве флага для определения цветного диапазона.

В конце зеленые ячейки от A5 до A22 должны быть заполнены числами от 1 до 18. Также переменной startRow должно быть присвоено значение = 5 (начальная строка цветного диапазона), а endRow должно быть присвоено значение = 22 (конечная строка цветного диапазона.

Мой код генерирует ошибку # 91, переменная объекта или с переменной блока не установлена.

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

Может кто-нибудь, пожалуйста, предложить решение или даже лучший код? Большое спасибо

Возможно, я не совсем понимаю, что вы пытаетесь сделать. Приведенный ниже код будет искать первую зеленую ячейку в столбце A, присвоит этой ячейке порядковый номер 1 и продолжит последовательную нумерацию последующих зеленых ячеек. Я надеюсь, что это то, чего вы хотели бы.

 Private Sub CommandButton1_Click()

    Const Col       As Long = 4697456           ' = amp;H47AD70
    
    Dim Ws          As Worksheet
    Dim Rcount      As Long                     ' Row
    Dim R           As Long
    
    Set Ws = ActiveSheet                        ' better = Worksheets("Sheet1")
    With Ws
        Rcount = .UsedRange.Rows.Count
        For R = 2 To Rcount
            ' find the frist occurrence of Col
            If .Cells(R, "A").Interior.Color = Col Then Exit For
        Next R
        
        If R > Rcount Then
            MsgBox "No cells of the specified colour were found.", _
                   vbInformation, "Unuccessful search"
        Else
            Rcount = R - 1
            Do
                .Cells(R, "A").Value = R - Rcount
                R = R   1
                ' loop until a different cell colour is encountered
            Loop While .Cells(R, "A").Interior.Color = Col
        End If
    End With
End Sub
  

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

1. Пожалуйста, замените

 Cells(row.row, 1).Select
  

с

 Set cell = cells(row.row, 1)
cell.Select 'not necessary, but you maybe want seeing what happens during testing...
  

Только выбор ячейки не сообщает VBA, что это именно та ячейка, которая нужна коду. 🙂

2. У вас опечатка:

 And iRow = 2 Then
  

Это, очевидно, должно быть:

 And i = 2 Then
  

3. Что является целью использования EndRow переменной. Если он не используется для того, чтобы что-то сделать. Он получает значение только в конце…

4. On Error GoTo ErrorHandler может использоваться / имеет значение, только если вы вставляете On Error Resume Next в первые строки кода. В противном случае ошибка не будет обнаружена.

Тогда не рекомендуется использовать имена переменных, такие как row , cell . Они могут создавать проблемы при отладке сложного кода…