Блог

Мастера VBA. Пожалуйста, посмотрите на приведенный ниже код. Возвращайте ошибку 424 всякий раз, когда доходит до первого «ИНАЧЕ, ЕСЛИ», и проблема связана с xDBa, которая должна возвращать адрес ячейки. Я не понимаю, почему. xR правильно возвращает значение из требований листа. xRa правильно возвращает ссылку на адрес xR. xDB правильно возвращает значение из БАЗЫ ДАННЫХ листа, однако xDBa выдает ошибку. Не понимаю, почему. Я просто добавил .Адрес в конце строки кода.

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

Мой вопрос касается только этой проблемы, а не способа построения кода. Я пытаюсь понять, что именно здесь не работает.

В основном код должен сравнивать значения между 2 листами, используя сопоставление индексов, чтобы получить значение ячейки и ссылку на ее адрес из листа требований и сравнить со значением ячейки, соответствующим тем же первичным ключам ( ролям и функциям) в листе БАЗЫ данных. Всякий раз, когда оно совпадает, значение ячейки в листе БАЗЫ ДАННЫХ будет выделяться зеленым, если не красным цветом. Если значение существует только в листе повторных требований, но не в БАЗЕ данных, то оно будет выделено красным цветом.

 Sub index_match_address_test()


Dim shR, shDB As Worksheet
    Set shR = ThisWorkbook.Sheets("Requirements")
        Set shDB = ThisWorkbook.Sheets("DATA BASE")
        
'Cell indxs for "Role" phrase - DATA BASE

  With shDB.Range("A1:F10")
            Set rngDB = .Find(What:="Role", _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext)
            If Not rngDB Is Nothing Then
                Application.GoTo rngDB, True
            Else
               MsgBox "Cell reference not found - contact with tool owner to solve issue"
            End If
    End With

    
DBrow = Split(rngDB.Address(1, 0), "$")(1) ' "DB Folder" row number
    DBcol = Split(rngDB.Address(1, 0), "$")(0) ' "DB Folder" column index letter
        DBcolIndx = Range(DBcol amp; 1).Column        ' "DB Folder" column index number
        
'Cell indxs for "Group" phrase - Requirements
  With shR.Range("A1:F10")
            Set rngR = .Find(What:="Role", _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            lookat:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext)
            If Not rngR Is Nothing Then
                Application.GoTo rngR, True
            Else
               MsgBox "Cell reference not found - contact with tool owner to solve issue"
            End If
    End With
    
Rrow = Split(rngR.Address(1, 0), "$")(1) ' "R Folder" row number
    Rcol = Split(rngR.Address(1, 0), "$")(0) ' "R Folder" column index letter
        RcolIndx = Range(Rcol amp; 1).Column        ' "R Folder" column index number

'get last rows and columns
lrR = shR.Cells(Rows.Count, RcolIndx).End(xlUp).Row
    lcR = shR.Cells(Rrow, shR.Columns.Count).End(xlToLeft).Column

lrDB = shDB.Cells(Rows.Count, DBcolIndx).End(xlUp).Row
    lcDB = shDB.Cells(DBrow, shDB.Columns.Count).End(xlToLeft).Column

frowR = Rrow   1
lrowR = lrR
    

Stop


For HR = RcolIndx   1 To lcR
    For VR = frowR To lrowR

R_Range = shR.Range(shR.Cells(frowR, RcolIndx   1), shR.Cells(lrowR, lcR))

    R_Lookup_Values1_Range = shR.Range(shR.Cells(frowR, RcolIndx), shR.Cells(lrowR, RcolIndx))
    
        R_Lookup_Value1 = shR.Range(shR.Cells(VR, RcolIndx), shR.Cells(VR, RcolIndx))
        
            R_Lookup_Values_Role_Range = shR.Range(shR.Cells(Rrow, RcolIndx   1), shR.Cells(Rrow, lcR))
            
                R_Lookup_Values_Role = shR.Range(shR.Cells(Rrow, HR), shR.Cells(Rrow, HR))


DB_Range = shDB.Range(shDB.Cells(DBrow   1, DBcolIndx   1), shDB.Cells(lrDB, lcDB))

    DB_Lookup_Values1_Range = shDB.Range(shDB.Cells(DBrow, DBcolIndx   1), shDB.Cells(DBrow, lcDB))
     
      DB_Lookup_Values_Role_Range = shDB.Range(shDB.Cells(DBrow   1, DBcolIndx), shDB.Cells(lrDB, DBcolIndx))

xR = Application.Index(shR.Range(shR.Cells(frowR, RcolIndx   1), shR.Cells(lrowR, lcR)), Application.Match(shR.Range(shR.Cells(VR, RcolIndx), shR.Cells(VR, RcolIndx)), shR.Range(shR.Cells(frowR, RcolIndx), shR.Cells(lrowR, RcolIndx)), 0), Application.Match(shR.Range(shR.Cells(Rrow, HR), shR.Cells(Rrow, HR)), shR.Range(shR.Cells(Rrow, RcolIndx   1), shR.Cells(Rrow, lcR)), 0))
    xRa = Application.Index(shR.Range(shR.Cells(frowR, RcolIndx   1), shR.Cells(lrowR, lcR)), Application.Match(shR.Range(shR.Cells(VR, RcolIndx), shR.Cells(VR, RcolIndx)), shR.Range(shR.Cells(frowR, RcolIndx), shR.Cells(lrowR, RcolIndx)), 0), Application.Match(shR.Range(shR.Cells(Rrow, HR), shR.Cells(Rrow, HR)), shR.Range(shR.Cells(Rrow, RcolIndx   1), shR.Cells(Rrow, lcR)), 0)).Address

xDB = Application.Index(DB_Range, Application.Match(R_Lookup_Values_Role, DB_Lookup_Values_Role_Range, 0), Application.Match(R_Lookup_Value1, DB_Lookup_Values1_Range, 0))

     If IsError(xDB) Then
            shR.Range(xRa).Font.ColorIndex = 46
                shR.Range(xRa).Interior.ColorIndex = 36
        ElseIf xR = xDB Then xDBa = Application.Index(DB_Range, Application.Match(R_Lookup_Values_Role, DB_Lookup_Values_Role_Range, 0), Application.Match(R_Lookup_Value1, DB_Lookup_Values1_Range, 0)).Address
            shDB.Range(xDBa).Font.Color = vbGreen
                  
        Else
            xDBa = Application.Index(DB_Range, Application.Match(R_Lookup_Values_Role, DB_Lookup_Values_Role_Range, 0), Application.Match(R_Lookup_Value1, DB_Lookup_Values1_Range, 0)).Address
                shDB.Range(xDBa).Font.Color = vbRed
                    shDB.Range(xDBa).Interior.ColorIndex = 22
        End If

Next VR
    Next HR

End Sub