excel - 运行时错误 1004 VBA，设置一个范围的颜色等于另一个

Question

我在这条确切的行上遇到了运行时错误。

Range("Aqual").Offset(0, i).Interior.color = rg.Offset(0, i + 11).Interior.color

我只是想将一个工作表中的一个范围的颜色与另一个工作表中的另一个范围相匹配。我已经尝试了对该行的各种故障排除重写，并试图将其包含在一个单独的子中，但它仍然失败。（我已将这些故障排除行注释掉，它们也都失败了。）我仍然无法得到它，并且浪费了几天时间试图解决这个问题。这Range("Aqual")是sheet1“F8”中的命名范围。for循环是这样的，它在 6 列中移动。我的工作表不受保护，我的工作簿也不受保护。

Option Explicit

Dim rg As Range
Dim i As Integer

Function posABC(ByVal A As String, ByVal B As String, ByVal C As String, ByVal D As String, ByVal G As Integer) As String
    On Error GoTo errormsg
    Application.EnableEvents = False

    Dim output As String
    Dim code As String
    Dim priKVA As String
    Dim secKVA As String
    Dim readCode As String
    Dim secOffset As Integer
    Dim writeRange As Range
    Dim readRange As Range
    
    output = "empty code"
    code = A & B & C
    If G >= 0 And G <= 3 Then
        secOffset = 0
    Else
        secOffset = G - 3
    End If
    
    For Each rg In Range("tblPosA")
        readCode = rg.Value & rg.Offset(0, 1).Value & rg.Offset(0, 2).Value
        If readCode = code Then
            priKVA = rg.Offset(0, 4).Value
            
            If D = "1" Then
                secKVA = rg.Offset(1, 5 + secOffset).Value
            Else
                secKVA = rg.Offset(0, 5 + secOffset).Value
            End If
            
            For i = 0 To 5
               
               Range("Aqual").Offset(0, i).Interior.color = rg.Offset(0, i + 11).Interior.color
                
'               Set writeRange = Range("Aqual").Offset(0, i)
'               Set readRange = rg.Offset(0, i + 11)
'               writeRange.Interior.color = readRange.Interior.color
               
'                Call matchColor(Range("Aqual").Offset(0, i), rg.Offset(0, i + 11))
                
'               Range("F8").Interior.color = RGB(0, 255, 0)
               
               
'               Select Case True
'                    Case rg.Offset(0, i + 11).Interior.color = vbRed
'                        Range("Aqual").Offset(0, i).Interior.color = vbRed
'                    Case rg.Offset(0, i + 11).Interior.color = vbGreen
'                        Range("Aqual").Offset(0, i).Interior.color = vbGreen
'                    Case rg.Offset(0, i + 11).Interior.color = vbYellow
'                        Range("Aqual").Offset(0, i).Interior.color = vbYellow
'                End Select
            Next i
            
            Exit For
        End If
    Next rg
    
    output = "Primary kVA= " & priKVA & vbNewLine & "Secondary kVA= " & secKVA
            
    posABC = output
    Application.EnableEvents = True
errormsg:
    MsgBox Err.Description & " " & Err.Number
End Function

如果使用此子进行操作，它仍然会失败。

Sub matchColor(ByVal writeRange As Range, ByVal readRange As Range)
    writeRange.Interior.color = readRange.Interior.color
End Sub

出于某种原因，我不知道。当我试图隔离故障时，这个 sub 确实有效。

Sub colortest()
  Dim writeRange As Range
  Dim readRange As Range
  Dim rg As Range
  
  Set rg = Sheet7.Range("L6")
  Set writeRange = Range("Aqual").Offset(0, 0)
  Set readRange = rg.Offset(0, i)
  
  writeRange.Interior.color = readRange.Interior.color
      
End Sub

标签： excelvbaruntime-errornamed-ranges