|
楼主 |
发表于 2023-3-13 15:40
|
显示全部楼层
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Integer, y As Integer, Targ As Range, Th As Worksheet, Dh As Worksheet
Dim xs As Integer, xe As Integer, BgC As Long
Set Dh = ThisWorkbook.Sheets("Sets")
Set Th = ActiveSheet
For Each Targ In Target
x = Targ.Column
y = Targ.Row
If Th.Cells(3, x) = "SN" And Th.Cells(2, x).MergeCells And Th.Cells(2, x).MergeArea.Cells(1, 1) Like "DP[1-9]*" And y > 3 Then
xs = Th.Cells(2, x).MergeArea.Cells(1, 1).Column
xe = xs + Th.Cells(2, x).MergeArea.Columns.Count - 1
If Targ.Value = "" Then
BgC = xlNone
Else
Set f = Dh.Range("A:A").Find(Targ.Value, , , xlWhole)
If f Is Nothing Then
BgC = xlNone
Else
BgC = Dh.Cells(f.Row, 2).Interior.Color
End If
End If
Th.Range(Th.Cells(y, xs), Th.Cells(y, xe)).Interior.Color = BgC
End If
Next
End Sub
|
|