Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim wsa As Worksheet
Dim wsb As Worksheet
Set wsa = Sheets("sheet1")
Set wsb = Sheets("sheet2")
Application.ScreenUpdating = False
Application.EnableEvents = False
For i = 1 To wsb.Range("A" & Rows.Count).End(xlUp).Row
If wsa.Range("a" & i).Interior.Color = RGB(255, 0, 0) Then
wsa.Range("a" & i).Value = ""
Else
wsa.Range("a" & i).Value = wsb.Range("a" & i).Value
End If
Next i
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("e4:e34")) Is Nothing Then
Application.EnableEvents = False
For i = 4 To 34
If Cells(i, 3) = Cells(i, 5) Then
With Range("b" & i).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
xlBetween, Formula1:="=$d$42:$c$42"
.IgnoreBlank = True
.InCellDropdown = True
.InputTitle = ""
.ErrorTitle = ""
.InputMessage = ""
.ErrorMessage = ""
.ShowInput = True
.ShowError = True
End With
ElseIf Cells(i, 2) <> Cells(i, 3) Then
Range("b" & i).Validation.Delete
End If
Next i
End If
Application.EnableEvents = True
End Sub
.png "min17")
کامنت