У меня есть таблица Excel, похожая на это (Sheet1):

enter image description here

Я хочу, чтобы для всех строк (которые являются динамическими) в столбце J содержится NEW-LOCATION , я хотел бы скопировать информацию об этих строках из столбцов A, C, D и E на другой лист ( Sheet2), но я также смогу добавить новую информацию на новый лист, как показано ниже:

enter image description here

Зеленая часть скопирована с Sheet1, а желтая часть - это то, что я пишу на Sheet2. Он должен быть динамическим, и если значение NEW-LOCATION удаляется в Sheet1, строка с информацией в Sheet2 должна быть удалена.

Кто-нибудь знает, как с этим справиться? Это не обязательно должен быть код, это может быть формула, условное форматирование или любые другие элементы Excel по умолчанию, которые могут с этим справиться.

0
Markus Sacramento 26 Фев 2018 в 13:50

1 ответ

Лучший ответ

Пожалуйста, проверьте его перед использованием на реальных данных, возможно, я что-то пропустил.
То, что я придумал до сих пор, я прокомментировал части кода для ясности, обратите внимание, что это модуль Sub Worksheet_Change для Sheet1, вставьте его соответственно:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim Main As Worksheet, Secondary As Worksheet
    Dim iCell As Range, FoundRange As Range
    Dim lRow As Long

    '   Define worksheets for simplicity
    With ThisWorkbook
        Set Main = .Worksheets("Sheet1")
        Set Secondary = .Worksheets("Sheet2")
    End With

    '   Calculate last row on Sheet2 (by column "A")
    lRow = Secondary.Range("A" & Secondary.Rows.Count).End(xlUp).Row

    '   Check if changes were made in columns "J" (Information)
    '   If changes weren't made in column "J" leave this sub
    If Intersect(Target, Main.Columns("J")) Is Nothing Then Exit Sub

    '   Loop through each changed cell of column "J"
    For Each iCell In Intersect(Target, Main.Columns("J")).Cells
        '   Find location on Sheet2
        'Main.Range("A" & iCell.Row).Value
        Set FoundRange = Secondary.Range("A2:A" & lRow).Find(Main.Range("A" & iCell.Row).Value, , xlValues, xlWhole)
        '   If value of the changed cell is "NEW-LOCATION"..
        If iCell.Value = "NEW-LOCATION" Then
            '   And it didn't find this location on Sheet2..
            If FoundRange Is Nothing Then
                '   Add new location
                Secondary.Range("A" & lRow + 1).Value = Main.Range("A" & iCell.Row).Value
                Secondary.Range("B" & lRow + 1 & ":D" & lRow + 1 & "").Value = Main.Range("C" & iCell.Row & ":E" & iCell.Row & "").Value
                lRow = lRow + 1
            End If
        '   If value of the changed cell is NOT "NEW-LOCATION"..
        Else
            '   And it found this location in Sheet2..
            If Not FoundRange Is Nothing Then
                '   Delete row with this location
                FoundRange.EntireRow.Delete
                lRow = lRow - 1
            End If
        End If
    Next
End Sub
1
AntiDrondert 26 Фев 2018 в 16:30