Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim sh1 As Worksheet, sh2 As Worksheet, sh3 As Worksheet
Set sh1 = Worksheets("Замечания"): Set sh2 = Worksheets("Справка 3в1"): Set sh3 = Worksheets("Результат")
sh3.Range("A3:F1000").ClearContents
FIO = Cells(Target.Row, 2)
k = 3
lr = sh1.Cells(Rows.Count, 1).End(xlUp).Row
For i = 4 To lr
If Target.Column = 3 Then ' ПОЛУЧЕНО
If sh1.Cells(i, 8) = FIO Then
If sh1.Cells(i, 4) >= sh2.Cells(2, 1) And sh1.Cells(i, 4) <= sh2.Cells(2, 2) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8)
k = k + 1
End If
End If
ElseIf Target.Column = 7 Then ' Получено (красная линия):
If sh1.Cells(i, 8) = FIO And sh1.Cells(i, 9) = "входит" Then
If sh1.Cells(i, 4) >= sh2.Cells(2, 1) And sh1.Cells(i, 4) <= sh2.Cells(2, 2) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8)
k = k + 1
End If
End If
ElseIf Target.Column = 11 Then ' УСТРАНЕНО
If sh1.Cells(i, 8) = FIO Then
If sh1.Cells(i, 6) >= sh2.Cells(2, 1) And sh1.Cells(i, 6) <= sh2.Cells(2, 2) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8):
k = k + 1
End If
End If
ElseIf Target.Column = 15 Then ' Устранено (красная линия):
If sh1.Cells(i, 8) = FIO And sh1.Cells(i, 9) = "входит" Then
If sh1.Cells(i, 6) >= sh2.Cells(2, 1) And sh1.Cells(i, 6) <= sh2.Cells(2, 2) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8)
k = k + 1
End If
End If
ElseIf Target.Column = 19 Then ' Всего в работе
If sh1.Cells(i, 8) = FIO Then
If IsEmpty(sh1.Cells(i, 6)) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8)
k = k + 1
End If
End If
ElseIf Target.Column = 23 Then ' Всего в работе (красная линия):
If sh1.Cells(i, 8) = FIO And sh1.Cells(i, 9) = "входит" Then
If IsEmpty(sh1.Cells(i, 6)) Then
sh3.Cells(k, 1) = sh1.Cells(i, 1): sh3.Cells(k, 2) = sh1.Cells(i, 2): sh3.Cells(k, 3) = sh1.Cells(i, 3)
sh3.Cells(k, 4) = sh1.Cells(i, 4): sh3.Cells(k, 5) = sh1.Cells(i, 5): sh3.Cells(k, 6) = sh1.Cells(i, 8)
k = k + 1
End If
End If
End If
Next i
End Sub
|