Изменения цели Excel VBA при использовании Intersect - PullRequest
0 голосов
/ 24 декабря 2018

Здравствуйте, замечательные профессионалы Excel!

Я полностью самоучка в использовании VBA, когда ищу в Google, когда хочу что-то сделать.Я знаю, что мой код неэффективен и примет любые советы.Итак, к делу.

Моя рабочая книга используется для сравнения доходов.Конкретно доход делят супруги.Например.Проверьте доход за 2016 год против дохода за 2017 год в поисках значительных отклонений.

У меня автоматически работает код, чтобы убедиться, что на экране никогда не было пробелов, и автоматически суммировать доходы, если совпадают годы.

Скриншот рабочей книги

Здесь я сталкиваюсь с проблемами.

  1. Когда я печатаю на любой строке, она автоматически переходит на B4, когда я нажимаю клавишу ввода, введите
  2. Если я изменю год (измените 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

Любая помощь, которую вы можете оказать, высоко ценится.

Спасибо!

...