0

VBA 大师。请看下面的代码。每当到达第一个“ELSE IF”时返回 424 错误并且问题出在 xDBa - 它应该返回单元地址。我不明白为什么。xR 从工作表要求中正确返回值。xRa 正确返回 xR 的地址引用。xDB 从工作表 DATA BASE 中正确返回值，但是 xDBa 出现错误。不明白为什么。我刚刚在代码行的末尾添加了 .Address 。

这只是我正在处理的代码示例。提供了我仅为测试此问题而创建的 excel 示例，并且原始文件很大。创建代码是为了回忆我在使用原始代码时遇到的问题。

我的问题只涉及这个问题，而不是代码的构建方式。我试图了解什么在这里不起作用。

基本上代码应该使用索引匹配比较两张表之间的值，以从需求表中获取单元格值及其地址引用，并与在数据库表中匹配相同主键（角色和函数）的单元格值进行比较。每当匹配时，数据库表中的单元格值将突出显示绿色，如果不是红色。如果值仅存在于 Reuirements 表中而不存在于 DATA BASE 中，则将突出显示为红色。

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 & 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 & 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

在此处输入图像描述

在此处输入图像描述

4

0 回答 0