如果在保留条件格式设置规则时更改或清除了另一个单元格，则VBA清除单元格的内容

Question

我已经搜索了这个问题，但我似乎无法在任何地方找到正确的答案。我是VBA的新手，请原谅我，如果我的问题听起来很愚蠢。

我有一个可在工作表部分找到的VBA代码。

当单元格E13被更改或清除时，单元格Q13被清除。同样，如果更改或清除E14，则清除单元格Q14。这一直到第499行。这也适用于E3和Q3。 请注意，Q3的条件格式规则与Q13-Q499的条件格式规则不同。此外，Q13-Q499共享相同的条件格式规则。

然而，在行13-499 中，当E列中的单元格（例如E20）被清除时，这会更改Q列中相对单元格的条件格式设置规则，即Q20。出于某种原因，清除E20似乎适用于Q20条件格式规则Q3。

有人可以帮我调整代码，使其完成目前的工作，还能保留条件格式规则吗？

这可能会有所帮助。以下是我在Q列中的条件格式规则。

Q3： Q3默认填充颜色为“蓝色”，默认边框为“所有边框”。 1）如果E3 =“公司”，将Q3的填充颜色更改为“白色”，并将边框保持为“所有边框”。 2）如果Q3＆lt;＆gt;“公司”，请将填充颜色保持为“蓝色”并仅将边框更改为“左边框”。

Q13-Q499 Q13-Q499的默认填充颜色为“白色”，默认边框为“所有边框”。 1）如果Q13-Q499 =“公司”，请将填充颜色保持为“白色”，并将边框保持为“所有边框”。 1）如果Q13-Q499＆lt;＆gt;“公司”，将Q13-Q499的填充颜色更改为“灰色”并将边框更改为“左和右边框”。

我正在使用的VBA代码如下。它粘贴在工作表部分：

Private Sub Worksheet_Change(ByVal Target As Range)
    With Target
        If .Column = 5 Then
            Rem Clear Columns Q
            .Cells.Offset(, 12).ClearContents

            Rem Enable Events after changes
            Application.EnableEvents = 1

          End If: End With
          End If
          End Sub

我想我刚刚发现了问题。我在模块中粘贴了一个Sub Copyrow（）代码。当单击一个按钮时，它用于将一组单元格的内容复制到电子表格的最后一个非空白行。由于单元格Q3具有更改其颜色的条件格式规则，它似乎是复制Q3的条件格式太。你可以修改我的代码，这样只有在复制Q3时，代码才会“粘贴特殊的”VALUES而不是一切。这是我的模块代码：

Option Explicit

Sub copyRow()
Dim ws As Worksheet
Dim lRow As Long

' define which worksheet to work on, i.e. replace Sheet1 with the name of 
your sheet
Set ws = ActiveWorkbook.Sheets("1. Clients Details")

' determine the last row with content in column D and add one
lRow = ws.Cells(Rows.count, "D").End(xlUp).Row + 1

' copy some cells into their ranges
ws.Range("D3:F3").Copy ws.Range("D" & lRow)
ws.[D1].Select

' combine G3, H3, I3, J3 and copy into column E, next empty row
ws.Range("G" & lRow) = ws.[G3] & " " & ws.[H3] & ", " & ws.[I3] & " " & ws.
[J3] & " "

' copy the other cells into their ranges
ws.Range("K3:P3").Copy ws.Range("K" & lRow)
ws.[K1].Select

' combine G3 & H3
ws.Range("Z" & lRow) = ws.[G3] & " " & ws.[H3]

' combine I3, J3
ws.Range("AA" & lRow) = ws.[I3] & "       " & ws.[J3]


' copy Q3 into column Q only, if Q3 = "Company"
If Worksheets("1. Clients Details").Range("E3").Value = "Company" Then
ws.Range("Q3").Copy ws.Range("Q" & lRow)


End If
ActiveSheet.Cells(Rows.count, "D").End(xlUp).Activate
End Sub

Answer 1

使用以下代码替换ws.Range("Q3").Copy ws.Range("Q" & lRow)程序底部附近的这行代码CopyRow：

`ws.Range（“Q”＆amp; lRow）.Value = ws.Range（“Q3”）。Value'