Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink) Target.Range.Interior.ColorIndex = 6 Target.Range.Cells.Interior.ColorIndex = 6 End Sub这个VBA代码为什么指向的单元格不会填充颜色

这段VBA代码的作用是在单元格中添加超链接时，单击超链接后会将目标单元格的背景色和字体颜色都设为颜色索引6（即黄色）。但是，该代码没有直接指定特定的单元格进行填充颜色。相反，它是通过超链接的目标范围（即单元格）来设置颜色。

可能的原因是：如果您单击的超链接没有指向一个单元格，则此代码将无法填充颜色。您可以尝试在单元格中添加超链接并单击它，以查看是否会填充颜色。

相关问题

以下VBA代码已经存在二定义名称，帮我重新改进一下 Private Sub Worksheet_Change(ByVal Target As Range) Dim i As Integer Dim j As Integer Dim k As Integer Dim ws As Worksheet Set ws = ActiveSheet If Target.Address = "$B$2" Then For i = 9 To 40 For j = 2 To 7 If ws.Cells(i, j).Value = ws.Cells(8, 5).Value Then For k = 3 To 4 ws.Cells(i, j + k - 2).Value = ws.Cells(Application.Match(ws.Cells(i, 1).Value, ws.Range("AK9:AK40"), 0) + 8, k).Value Next k End If Next j Next i End If End Sub

以下是更新后的代码，避免了二次定义名称的问题：

Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Dim j As Integer
Dim k As Integer
Dim ws As Worksheet
Set ws = ActiveSheet

If Target.Address = "$B$2" Then
For i = 9 To 40
For j = 2 To 7
If ws.Cells(i, j).Value = ws.Cells(8, 5).Value Then
For k = 3 To 4
ws.Cells(i, j + k - 2).Value = ws.Cells(Application.Match(ws.Cells(i, 1).Value, ws.Range("AK9:AK40"), 0) + 8, k).Value
Next k
End If
Next j
Next i
End If
End Sub

"Private Sub Worksheet_Change(ByVal Target As Range) If Target.CountLarge > 1 Then Exit Sub If Intersect(Target, Range("A2:N" & Rows.Count)) Is Nothing Then Exit Sub If Target.Row < 3 Then Exit Sub Dim key As String key = Cells(Target.Row, 4).Value If key = "" Then Exit Sub Dim ws As Worksheet On Error Resume Next Set ws = Worksheets(key) On Error GoTo 0 If ws Is Nothing Then Set ws = Worksheets.Add(after:=Sheets(Sheets.Count)) ws.Name = key Sheets("汇总表").Range("$A2:$N2").Copy ws.Range("A1") Else Dim i As Long i = Application.Match(key, Sheets("汇总表").Range("D:D"), 0) Sheets("汇总表").Range("$A2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1") End If End Sub"运行时提示运行时错误 "1004" 无法对合并单元格执行此操作怎么修改代码?

这段代码中涉及到了复制和粘贴操作，如果目标单元格所在的行或列是合并单元格，就会出现无法进行操作的错误。我们可以在复制时避免复制合并单元格，可以修改代码如下：

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.CountLarge > 1 Then Exit Sub
    If Intersect(Target, Range("A2:N" & Rows.Count)) Is Nothing Then Exit Sub
    If Target.Row < 3 Then Exit Sub
    Dim key As String
    key = Cells(Target.Row, 4).Value
    If key = "" Then Exit Sub
    Dim ws As Worksheet
    On Error Resume Next
    Set ws = Worksheets(key)
    On Error GoTo 0
    If ws Is Nothing Then
        Set ws = Worksheets.Add(after:=Sheets(Sheets.Count))
        ws.Name = key
        ' 避免复制合并单元格，只复制第一个单元格
        Sheets("汇总表").Range("$A2:$A2,$B2:$N2").Copy ws.Range("A1")
    Else
        Dim i As Long
        i = Application.Match(key, Sheets("汇总表").Range("D:D"), 0)
        ' 避免复制合并单元格，只复制第一个单元格
        Sheets("汇总表").Range("$A2:$A2,$B2:$N2").Offset(i - 1).Resize(1).Copy ws.Range("A1")
    End If
End Sub

修改后的代码在复制时只复制了合并单元格中的第一个单元格，就避免了无法进行操作的错误。