Всем привет !

Не могу понять почему у меня не работает вот это чудо :)
Нужно установить контроль за вводом данных в ячейки

Public sh1, sh2 As Object
' Событие для конкретной ячейки
Private Sub Worksheet_SelectionChange(ByVal Target As Excel.Range)
Set sh1 = ThisWorkbook.Sheets("Данные")
Application.MoveAfterReturn = False

Flag = 0

If Target.Column = 22 Then
r = Target.Row
c = Target.Column

If Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 22)))) <> 8 And Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 22)))) <> 0 Then
Application.StatusBar = "Длина счета должна быть 8 символов или пусто!"
'MsgBox ("Длина счета должна быть 8 символов !")
Selection.Font.ColorIndex = 3
Exit Sub
ElseIf Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 22)))) = 8 Or Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 22)))) = 0 Then
Selection.Font.ColorIndex = 0
Application.StatusBar = ""
End If

' если счет 23 или 29
If (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "23") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "29") Then
sh1.Cells(ActiveCell.Row, 30).Value = sh1.Cells(ActiveCell.Row, 22).Value
End If

' Условие 23,29,31,32,3002 - 800102 или 800302
If (sh1.Cells(ActiveCell.Row, 23) = "800102" Or sh1.Cells(ActiveCell.Row, 23) = "800302") And _
((Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "23") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "29") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "31") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "32") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 4) = "3002")) Then
flag1 = 1
Selection.Font.ColorIndex = 0
' иначе если
ElseIf (sh1.Cells(ActiveCell.Row, 23) = "800102" Or sh1.Cells(ActiveCell.Row, 23) = "800302") And _
((Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "23") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "29") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "31") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "32") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 4) <> "3002")) Then
flag1 = 0
Application.StatusBar = "Для счетов 23*,29*,31*,32*, 3002* возможны только статьи затрат 800102,800302 !"
Selection.Font.ColorIndex = 3
End If

' 3001 - все статьи
If ((sh1.Cells(ActiveCell.Row, 23) = "800101" Or sh1.Cells(ActiveCell.Row, 23) = "800102") Or _
(sh1.Cells(ActiveCell.Row, 23) = "800301" Or sh1.Cells(ActiveCell.Row, 23) = "800302")) And _
(Left$(sh1.Cells(ActiveCell.Row, 22), 4) = "3001") Then
flag2 = 1
Selection.Font.ColorIndex = 0
ElseIf ((sh1.Cells(ActiveCell.Row, 23) = "800101" Or sh1.Cells(ActiveCell.Row, 23) = "800102") Or _
(sh1.Cells(ActiveCell.Row, 23) = "800301" Or sh1.Cells(ActiveCell.Row, 23) = "800302")) And _
(Left$(sh1.Cells(ActiveCell.Row, 22), 4) <> "3001") Then
flag2 = 0
Application.StatusBar = "Для счетов 3001* возможны только статьи затрат 800101,800102,800301,800302 !"
Selection.Font.ColorIndex = 3
End If

End If


' По статье затрат
If ActiveCell.Column = 23 Then
flag1 = 0
If Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 23)))) <> 6 Then
Application.StatusBar = "Длина статьи должна быть 6 символов !"
'MsgBox ("Длина статьи должна быть 6 символов !")
Selection.Font.ColorIndex = 3
Exit Sub
ElseIf Len(CStr(Trim(sh1.Cells(ActiveCell.Row, 23)))) = 6 Then
Selection.Font.ColorIndex = 0
Application.StatusBar = ""
End If

' Условие 23,29,31,32,3002 - 800102 или 800302
If (sh1.Cells(ActiveCell.Row, 23) = "800102" Or sh1.Cells(ActiveCell.Row, 23) = "800302") And _
((Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "23") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "29") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "31") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) = "32") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 4) = "3002")) Then
flag1 = 1
Selection.Font.ColorIndex = 0
' иначе если
ElseIf (sh1.Cells(ActiveCell.Row, 23) = "800102" Or sh1.Cells(ActiveCell.Row, 23) = "800302") And _
((Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "23") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "29") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "31") Or (Left$(sh1.Cells(ActiveCell.Row, 22), 2) <> "32") _
Or (Left$(sh1.Cells(ActiveCell.Row, 22), 4) <> "3002")) Then
flag1 = 0
Application.StatusBar = "Для счетов 23*,29*,31*,32*, 3002* возможны только статьи затрат 800102,800302 !"
Selection.Font.ColorIndex = 3
End If

' 3001 - все статьи
If ((sh1.Cells(ActiveCell.Row, 23) = "800101" Or sh1.Cells(ActiveCell.Row, 23) = "800102") Or _
(sh1.Cells(ActiveCell.Row, 23) = "800301" Or sh1.Cells(ActiveCell.Row, 23) = "800302")) And _
(Left$(sh1.Cells(ActiveCell.Row, 22), 4) = "3001") Then
flag2 = 1
Selection.Font.ColorIndex = 0
ElseIf ((sh1.Cells(ActiveCell.Row, 23) = "800101" Or sh1.Cells(ActiveCell.Row, 23) = "800102") Or _
(sh1.Cells(ActiveCell.Row, 23) = "800301" Or sh1.Cells(ActiveCell.Row, 23) = "800302")) And _
(Left$(sh1.Cells(ActiveCell.Row, 22), 4) <> "3001") Then
flag2 = 0
Application.StatusBar = "Для счетов 3001* возможны только статьи затрат 800101,800102,800301,800302 !"
Selection.Font.ColorIndex = 3
End If


End If
Application.StatusBar = ""

Application.MoveAfterReturn = True

End Sub






Scio me nihil scire

<<Jojo®>>