Здравствуйте, замечательные профессионалы Excel!
Я полностью самоучка в использовании VBA, когда ищу в Google, когда хочу что-то сделать.Я знаю, что мой код неэффективен и примет любые советы.Итак, к делу.
Моя рабочая книга используется для сравнения доходов.Конкретно доход делят супруги.Например.Проверьте доход за 2016 год против дохода за 2017 год в поисках значительных отклонений.
У меня автоматически работает код, чтобы убедиться, что на экране никогда не было пробелов, и автоматически суммировать доходы, если совпадают годы.
Скриншот рабочей книги
Здесь я сталкиваюсь с проблемами.
- Когда я печатаю на любой строке, она автоматически переходит на B4, когда я нажимаю клавишу ввода, введите
- Если я изменю год (измените B4 на 2015), я хочу, чтобы он очистил соответствующийстрока.Я понимаю, что у меня нет никакого кода здесь, чтобы попытаться исправить это, но это только потому, что я не смог заставить его работать и не сохранил изменения.
Вот мойкод:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
Dim addValue As Boolean
Dim notZero As Boolean
Dim sumTest
Dim sumTotal
sumTest = 0
If Not Application.Intersect(Target, Range("B4:C13,H4:I13")) Is Nothing Then
For Each c In Target
If Not Application.Intersect(c, Range("B5:C13,H5:I13")) Is Nothing Then
Application.EnableEvents = False
If c.Value = "" Then
c.Value = 0
End If
ElseIf Not Application.Intersect(c, Range("B4,H4")) Is Nothing Then
If c.Value = "" Then
If Date >= January And Date <= June Then
c.Value = Year(Now()) - 3
Else
c.Value = Year(Now()) - 2
End If
End If
ElseIf Not Application.Intersect(c, Range("C4,I4")) Is Nothing Then
If c.Value = "" Then
If Date >= January And Date <= June Then
c.Value = Year(Now()) - 2
Else
c.Value = Year(Now()) - 1
End If
End If
End If
Next c
If Application.Intersect(Target, Range("B4, H4, C4, I4")) Is Nothing Then
If Not Application.Intersect(Target, Range("B5:B13, H5:H13")) Is Nothing Then
Application.EnableEvents = False
If MacroRunning = False Then
If Range("B4") = Range("H4") Then
If Range("B14") > 0 And Range("H14") > 0 Then
sumTotal = Range("B14") + Range("H14")
ElseIf Range("B14") <= 0 And Range("H14") > 0 Then
sumTotal = 0 + Range("H14")
ElseIf Range("B14") > 0 And Range("H14") <= 0 Then
sumTotal = Range("B14") + 0
Else
sumTotal = 0
Sheet1.Unprotect
Range("A17:C17").ClearContents
Range("A17:C17").ClearFormats
Sheet1.Protect
End If
For Each c In Target
If Not c = 0 Then
addValue = True
End If
Next c
For Each c In Range("B5:B13, H5:H13")
If Not c = 0 Then
notZero = True
End If
Next c
Sheet1.Unprotect
If addValue = True Then
Range("A17").Value = Range("B4").Value & " Combined Income"
Range("C17").Value = sumTotal
Range("A14").Copy
Range("A17:B17").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy
Range("C17").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
ElseIf Not notZero = False Then
Range("A17").Value = Range("B4").Value & " Combined Income"
Range("C17").Value = sumTotal
Range("A14").Copy
Range("A17:B17").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy
Range("C17").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Else
Range("A17:C17").ClearContents
Range("A17:C17").ClearFormats
End If
Sheet1.Protect
Else
Sheet1.Unprotect
Range("A17:C17").ClearContents
Range("A17:C17").ClearFormats
Sheet1.Protect
End If
End If
addValue = False
notZero = False
ElseIf Not Application.Intersect(Target, Range("C5:C13, I5:I13")) Is Nothing Then
Application.EnableEvents = False
If MacroRunning = False Then
If Range("C4") = Range("I4") Then
If Range("C14") > 0 And Range("I14") > 0 Then
sumTotal = Range("C14") + Range("I14")
ElseIf Range("C14") <= 0 And Range("I14") > 0 Then
sumTotal = 0 + Range("I14")
ElseIf Range("C14") > 0 And Range("I14") <= 0 Then
sumTotal = Range("C14") + 0
Else
sumTotal = 0
End If
For Each c In Target
If Not c = 0 Then
addValue = True
End If
Next c
For Each c In Range("C5:C13, I5:I13")
If Not c = 0 Then
notZero = True
End If
Next c
Sheet1.Unprotect
If addValue = True Then
Range("A18").Value = Range("C4").Value & " Combined Income"
Range("C18").Value = sumTotal
Range("A14").Copy
Range("A18:B18").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy
Range("C18").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
ElseIf Not notZero = False Then
Range("A18").Value = Range("C4").Value & " Combined Income"
Range("C18").Value = sumTotal
Range("A14").Copy
Range("A18:B18").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Range("C14").Copy
Range("C18").PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
Else
Range("A18:C18").ClearContents
Range("A18:C18").ClearFormats
End If
Sheet1.Protect
Else
Sheet1.Unprotect
Range("A18:C18").ClearContents
Range("A18:C18").ClearFormats
Sheet1.Protect
End If
End If
addValue = False
notZero = False
End If
End If
End If
wasBlank = False
Application.EnableEvents = True
Любая помощь, которую вы можете оказать, высоко ценится.
Спасибо!