Как ссылаться на многие текстовые ячейки и иметь ВСЕ форматирующую копию тоже?

Question

Сначала я написал эссе, но остановился на этом: У меня много данных, и мне нужно, чтобы мои функции Vlookup копировали как форматирование, так и сам текст.

Я нашел это из списка «Похожие вопросы»: ссылаюсь на ячейку, но продолжаю форматировать текст из исходной ячейки , который включает этот фрагмент кода:

Private changing As Boolean

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Target.Address = [A1].Address Or changing Then Exit Sub
changing = True
[A1].Copy [B1]
changing = False

End Sub

Теперь, похоже, это сработает для меня. Но мне нужен способ, чтобы он проверил одну из 24 ячеек на моем приемном листе и скопировал содержимое правильной исходной ячейки (из 3500+ строк на 60+ столбцов) на исходном листе. Прямо сейчас, исходные ячейки находятся с помощью VLookup; но как я могу связать макрос выше, чтобы проверить правильные исходные ячейки? Я мог бы сделать 24 копии вышеупомянутого фрагмента, по одной для каждой ячейки назначения, я думаю, что это будет работать, если проверять ячейки назначения только при их изменении, но ссылка B1 в фрагменте не будет работать, потому что исходная ячейка меняется с каждой записью.

Просто: я не очень хорош в VBA и не знаю, как использовать VLookup и приведенный выше фрагмент вместе.

Спасибо за ваши идеи!

---

edit: меня спросили о том, как найти исходные данные. У меня есть страница для печати с четырьмя раскрывающимися списками (они используют проверку по столбцу «Заголовок» базы данных), которые позволяют мне (отдельно) выбрать четыре записи из моей базы данных. Этот выбор затем запускает VLookup, которые переносят соответствующие данные из базы данных на страницу печати. База данных состоит из 3556 строк по 60 столбцов, из которых только 17 перетаскиваются на страницу печати. ​​

Большинство этих точек данных просто отлично перетягиваются. Установка ячейки назначения на «Shrink to fit» достаточна для того, чтобы убедиться, что данные, ну, соответствуют . Однако для пяти из них «Сократить до размера» недоступно, так как они (обычно) состоят из нескольких строк, поэтому необходимо включить «Обтекание текстом», что делает «Сокращение до размера» недоступным. Это означает, что я должен вручную вписать текст этих 5 точек данных для каждого из четырех вариантов на моей странице печати. Это может занять довольно много времени, особенно когда у меня есть сто или больше, чтобы распечатать.

В качестве альтернативы, поскольку я в основном уже сделал это, я мог бы вручную редактировать каждую исходную запись (устанавливая ширину столбцов и шрифт так же, как на странице печати), и, после того, как они были подогнаны, их можно скопировать целиком. в ячейки назначения на странице печати. ​​

Таким образом, в идеале код, предложенный выше, можно использовать для проверки, когда каждая из различных 24 ячеек (они не являются непрерывными) изменены, а затем для поиска правильной исходной ячейки (каждая ячейка, которая изменится, только когда-либо получит данные из ячейки в определенном столбце, например, H5, H77, H149 и H221 всегда будут получать свои данные из столбца CD в базе данных, тогда как V5, V77, V149 и V221 всегда будут получать свои данные из столбца BZ в базе данных) и скопируйте исходные данные (включая все форматирование текста).

---

edit 2: Ссылка на мою таблицу . Должен был сделать это для начала ...: p

Answer 1

Вот так, используя цикл (на основе вашего опубликованного кода):

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng
    Set rng = Application.Intersect(Target, Me.Range("A1:A24"))
    'Any changes in the range of interest?
    If Not rng Is Nothing Then
        Application.EnableEvents = False  'suspend event handling
        'Loop over the changed cells...
        For each c in rng.cells
            ProcessChange c '<< handle any lookups
        Next c
        Application.EnableEvents = True 'restore event handling
    End If

End Sub

РЕДАКТИРОВАТЬ: ваша опубликованная рабочая книга мало помогает, потому что мне слишком сложно тратить время на ее выяснение, но вот общий подход, который должен дать вам основу для поиска совпадений и копирования информации / форматирования из вашего лист "листинга".

'called for each changed cell
Sub ProcessChange(c As Range)

    Dim m, shtLookup As Workbook, valueCell As Range

    Set shtLookup = ThisWorkbook.Sheets("Database")

    'find the new value in the lookup sheet (in the first column)
    Set m = Application.Match(c.Value, shtLookup.Range("A:A"), 0)
    If Not IsError(m) Then

        'got a match: get the corresponding cell from col CD
        Set valueCell = shtLookup.Range("CD:CD").Cells(m)

        'do something with this cell
        With c.Offset(5, 5) '<< some place relative to the changed cell
            .Value = valueCell.Value   'copy value
            .Width = valueCell.Width   'copy width
            .Height = valueCell.Height 'copy height
        End With
    Else
        MsgBox "no match for '" & c.Value & "'"
    End If

End Sub