Мне просто нужно вырезать содержимое ячейки, оставив исходный формат ячейки без изменений, и вставить соответствующее форматирование ячейки назначения ... Думаю не редкость спросить?

Я искал, но пузырь поискового фильтра Google получил меня - нада.

Специальная паста не доступна для порезов? Параметры вставки неактивны.

Я попытался записать макрос для копирования с открытой боковой панелью буфера обмена (там скопировано значение), затем удалил исходную ячейку, пока я в ней (оставляя формат), затем вставил в целевую ячейку, щелкнув элемент буфера обмена. Это работает при записи, но записанный макрос возвращает ошибку "Сбой метода PasteSpecial для класса Worksheet". Пока элемент находится на боковой панели, фактический буфер обмена опустошен.

Кажется, есть некоторые возможные обходные пути: 1: прекратить очистку буфера обмена с помощью excel (какой гений выступил с идеей удаления буфера обмена? Полагаю, нам просто повезло, что они работали над Excel, а не с Windows или офисом ...) 2: каким-то образом вставить вырезанный текст как "значение" или "формула" или "HTML". 3. чрезвычайно длинный код для установки диапазона, копирования, вставки, повторного выбора диапазона, удаления, удаления имени диапазона, повторного выбора диапазона назначения!

Был бы очень признателен за помощь с этой загадкой.

2 ответа2

0

Сделал это! С помощью Как исключить перекрытие диапазонов из диапазона?(Переместить макрос содержимого ячейки)

Sub E____MoveSelectedCellsContentsOnlyKeepFormats_Ctrl_M()

Application.CutCopyMode = False 'clears any existing copy mode
On Error GoTo EXITSUB 'exits if cancel clicked

    Dim RANGE_TO_COPY As Range 'define inputbox variable
    Dim CELL_TO_PASTE_TO As Range 'define inputbox variable

'-----------name SOURCE range = selected before macro started
    Set RANGE_TO_COPY = Selection 'is this necessary, when not using inputbox?
        COPYSOURCE = RANGE_TO_COPY.Address(False, False) 'name the inputbox selection as a range

'=========== inputbox to select PASTE destination
    Set CELL_TO_PASTE_TO = Application.InputBox("select top left cell of range to PASTE TO, with the mouse", Default:=Selection.Address, Type:=8)

'------------- assigns name to the selected DESTINATION range
    PASTERANGE = CELL_TO_PASTE_TO.Address(False, False) 'name the inputbox selection as a range

'=========== action = COPY SOURCE
    Range(COPYSOURCE).Copy

'======================PASTE TO DESTINATION
'DEFAULT: PASTE FORMULAS AND NUMBER FORMATS (MATCHES DESTINATION FORMAT, keeps date/ etc original):

    Range(PASTERANGE) _
    .PasteSpecial Paste:=xlPasteFormulasAndNumberFormats, Operation:=xlNone, SkipBlanks:=False, Transpose:=False 'formulas+number format

'======DELETE SOURCE CELL CONTENTS - remove if COPY required
'------------ loop - from superuser - deletes source but NOT pasterange overlap
Dim rgLoop As Range, rgToDelete As Range
        For Each rgLoop In Range(COPYSOURCE).Cells
            If Intersect(rgLoop, Range(PASTERANGE).Resize(Range(COPYSOURCE).Rows.Count, Range(COPYSOURCE).Columns.Count)) Is Nothing Then
                If rgToDelete Is Nothing Then Set rgToDelete = rgLoop Else Set rgToDelete = Union(rgToDelete, rgLoop)
            End If
        Next rgLoop

        rgToDelete.ClearContents 'deletes contents keeps formatting

EXITSUB:

End Sub

:-)

0

Вот обходной путь без VBA/Makros:

Вместо того, чтобы выделять и вырезать "целую" ячейку, выделите и обрежьте "содержимое" ячейки (сначала выберите ячейку, затем, например, нажмите F2, а затем Ctrl+A). После того, как вы используете "вырезать", ячейка будет пустой, но формат не будет изменен.

При вставке ячейка назначения будет сохранять свой первоначальный формат, но получит значение / формулу из исходной ячейки. Если вы хотите перенести формат из источника в место назначения, просто используйте копирование и вставку (только вставка формата).

Всё ещё ищете ответ? Посмотрите другие вопросы с метками .