Блог

У меня есть книга Excel с четырьмя листами:

1. Магазин
2. Журнал
3. WZD
4. PZD

Функциональные возможности рабочей книги:

• Если что-либо изменится в столбцах B: I в листе «Журнал», то строка сохраняется в листе «Журнал».
• Если значение в столбце F в листе ‘Magazyn’ изменяется на ‘Biuro’, то строка сохраняется в листе ‘PZD’.
• Если значение в столбце F в листе ‘Magazyn’ изменяется на что-либо другое, кроме ‘Biuro’, тогда строка сохраняется в листе ‘PZD’.
• Sub Confirmation проверяет, дублируются ли значения в столбцах: B и I в листе «Журнал», если появляется окно сообщения «да».
• Это прекрасно работает, если я меняю значение в одной ячейке. Если я вставляю одну или несколько новых строк / строк в лист «Журнал», я получаю Run-time error "13": Type mismatch

Что я пытаюсь получить:

1. Изменение одной или нескольких ячеек в листе «Журнал» в диапазоне B: я внесу ввод в лист «Журнал»
2. Sub Confirmation будет работать с несколькими значениями.

Не могли бы вы помочь с этим?

Весь код ниже:

    Private myTarget As Range
    
    Private Sub Worksheet_Change(ByVal Target As Range)
    
        Set myTarget = Target
        CopyPaste
        CopyPasteWZD
        CopyPastePZD
        
        Confirmation Target
        
    End Sub
    
    Sub CopyPaste()
    
        If Not Intersect(myTarget, Range("B:I")) Is Nothing Then
    
            LastRow = Sheets("Logi").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row   1
    
            Sheets("Magazyn").Range("A" amp; myTarget.Row amp; ":J" amp; myTarget.Row).Copy Destination:=Sheets("Logi").Range("A" amp; LastRow)
    
        End If
    
    End Sub
    
    Sub CopyPastePZD()
    
        If Not Intersect(myTarget, Range("F:F")) Is Nothing Then
    
            LastRow = Sheets("PZD").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row   1
    
            If myTarget.Value = "Biuro" Then
    
                Sheets("Magazyn").Range("A" amp; myTarget.Row amp; ":J" amp; myTarget.Row).Copy Destination:=Sheets("PZD").Range("A" amp; LastRow)
            End If
    
        End If
    
    End Sub
    
    Sub CopyPasteWZD()
    
    
        If Not Intersect(myTarget, Range("F:F")) Is Nothing Then
    
            LastRow = Sheets("WZD").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row   1
    
            If myTarget.Value <> "Biuro" Then
    
                Sheets("Magazyn").Range("A" amp; myTarget.Row amp; ":J" amp; myTarget.Row).Copy Destination:=Sheets("WZD").Range("A" amp; LastRow)
            End If
    
        End If
    End Sub
    
    Sub Confirmation(ByVal Target As Range)
        With Target
            If (.Column <> 2 And .Column <> 9) Or .Cells.Count > 1 Then Exit Sub
    
            If WorksheetFunction.CountIf(Columns(.Column), .Value) > 1 Then
                Application.DisplayAlerts = False
                .ClearContents
                Application.DisplayAlerts = True
                MsgBox "Wprowadzona wartosc juz istnieje"
            End If
    
        End With
    End Sub
 

Перебирайте каждую ячейку измененного диапазона, т.е. Target . Кроме того, нет необходимости создавать другую переменную myTarget , поскольку она такая же, как Target . К вашему сведению, это просто дополнительные шаги.

1. Создайте цикл диапазона для измененных ячеек
2. Передайте инкрементную переменную каждому подразделу, при этом каждый подраздел обновляется, чтобы принимать параметр, а не глобальную переменную

 Private Sub Worksheet_Change(ByVal Target As Range)
    
Dim xTarget As Range

For Each xTarget In Target
    CopyPaste xTarget
    CopyPasteWZD xTarget
    CopyPastePZD xTarget
    Confirmation xTarget
Next xTarget
        
End Sub
 

 Sub CopyPastePZD(xTarget As Range)
    
    If Not Intersect(xTarget, Range("F:F")) Is Nothing Then
    
        LastRow = Sheets("PZD").Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row   1
    
        If myTarget.Value = "Biuro" Then
            Sheets("Magazyn").Range("A" amp; xTarget.Row amp; ":J" amp; xTarget.Row).Copy Destination:=Sheets("PZD").Range("A" amp; LastRow)
        End If
    
    End If
    
End Sub
 

Обратите внимание, что здесь приведен пример обновления одного следующего подраздела. Для каждого подраздела необходимо обновить переменную диапазона и включить параметр диапазона. Это устраняет необходимость в вашей переменной myTarget