быстрый способ копирования форматирования в excel

вы могли бы просто использовать Range("x1").value(11) что-то вроде ниже:

Sheets("Output").Range("$A:$A0").value(11) =  Sheets(sheet_).Range("$A:$A0").value(11)

диапазон имеет свойство по умолчанию "значение" плюс значение может иметь 3 необязательных orguments 10,11,12. 11-это то, что вам нужно для преобразования значений и форматов. Он не использует буфер обмена, поэтому он быстрее.- Дургеш!--3-->

помните, что когда вы пишете:

MyArray = Range("A1:A5000")

ты действительно пишешь

MyArray = Range("A1:A5000").Value

вы также можете использовать имена:

MyArray = Names("MyWSTable").RefersToRange.Value

но значение не является единственным свойством диапазона. Я использовал:

MyArray = Range("A1:A5000").NumberFormat

сомневаюсь

MyArray = Range("A1:A5000").Font

будет работать, но я бы ожидал

MyArray = Range("A1:A5000").Font.Bold

на работу.

Я не знаю, какие форматы вы хотите скопировать, так что вам придется попробовать.

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

сообщение редактировать информацию

разместив выше, я попробовал по собственному совету. Мои эксперименты с копированием шрифта.Цвет и шрифт.Полужирный для массива не удалось.

из следующих утверждений второй потерпел бы неудачу с несоответствием типа:

  ValueArray = .Range("A1:T5000").Value
  ColourArray = .Range("A1:T5000").Font.Color

ValueArray должен иметь тип variant. Я пробовал оба вариант и длинный для ColourArray без успеха.

я заполнил ColourArray значениями и попробовал следующее утверждение:

  .Range("A1:T5000").Font.Color = ColourArray

весь диапазон будет окрашен в соответствии с первым элементом ColourArray, а затем Excel зациклен, потребляя около 45% времени процессора, пока я не завершу его с помощью Диспетчера задач.

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

я построил эксперимент, который в целом отражает ваше требование. Я заполнил time1 листа 5000 строк из 20 ячеек, которые были выборочно отформатированы как: полужирный, курсив, подчеркивание, подстрочный, граничный, красный, зеленый, синий, коричневый, желтый и серый-80%.

С версией 1 я скопировал каждую 7-ю ячейку с листа " Time1 "на лист" Time2", используя copy.

С версии 2, я скопировал каждую 7-ю ячейку с листа " Time1 "на лист" Time2", скопировав значение и цвет через массив.

С версией 3 я скопировал каждую 7-ю ячейку с листа " Time1 "на лист" Time2", скопировав формулу и цвет через массив.

Версия 1 заняла в среднем 12,43 секунды, версия 2 заняла в среднем 1,47 секунды, а версия 3 заняла в среднем 1,83 секунды. Версия 1 скопировать формулу и форматирование, версия 2 копировать значения и цвет в то время как версия 3 скопировала формулы и цвет. С версиями 1 и 2 Вы можете добавить жирный и курсив, скажем, и все еще иметь некоторое время в руке. Однако я не уверен, что стоит беспокоиться, учитывая, что копирование 21,300 значений занимает всего 12 секунд.

** код для версии 1**

Я не думаю, что этот код включает в себя все, что нуждается в объяснении. Ответьте комментарием, Если я ошибаюсь, и я исправлю.

Sub SelectionCopyAndPaste()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual
  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  Do While True
    ColSrcCrnt = (NumSelect Mod 20) + 1
    RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
    If RowSrcCrnt > 5000 Then
      Exit Do
    End If
    Sheets("Time1").Cells(RowSrcCrnt, ColSrcCrnt).Copy _
                 Destination:=Sheets("Time2").Cells(RowDestCrnt, ColDestCrnt)
    If ColDestCrnt = 20 Then
      ColDestCrnt = 1
      RowDestCrnt = RowDestCrnt + 1
    Else
     ColDestCrnt = ColDestCrnt + 1
    End If
    NumSelect = NumSelect + 7
  Loop
  Debug.Print Timer - StartTime
  ' Average 12.43 secs
  Application.Calculation = xlCalculationAutomatic

End Sub

** код для Версии 2 и 3**

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

Type ValueDtl
  Value As String
  Colour As Long
End Type

Sub SelectionViaArray()

  Dim ColDestCrnt As Integer
  Dim ColSrcCrnt As Integer
  Dim InxVLCrnt As Integer
  Dim InxVLCrntMax As Integer
  Dim NumSelect As Long
  Dim RowDestCrnt As Integer
  Dim RowSrcCrnt As Integer
  Dim StartTime As Single
  Dim ValueList() As ValueDtl

  Application.ScreenUpdating = False
  Application.Calculation = xlCalculationManual

  ' I have sized the array to more than I expect to require because ReDim
  ' Preserve is expensive.  However, I will resize if I fill the array.
  ' For my experiment I know exactly how many elements I need but that
  ' might not be true for you.
  ReDim ValueList(1 To 25000)

  NumSelect = 1
  ColDestCrnt = 1
  RowDestCrnt = 1
  InxVLCrntMax = 0      ' Last used element in ValueList.
  With Sheets("Time2")
    .Range("A1:T715").EntireRow.Delete
  End With
  StartTime = Timer
  With Sheets("Time1")
    Do While True
      ColSrcCrnt = (NumSelect Mod 20) + 1
      RowSrcCrnt = (NumSelect - ColSrcCrnt) / 20 + 1
      If RowSrcCrnt > 5000 Then
        Exit Do
      End If
      InxVLCrntMax = InxVLCrntMax + 1
      If InxVLCrntMax > UBound(ValueList) Then
        ' Resize array if it has been filled 
        ReDim Preserve ValueList(1 To UBound(ValueList) + 1000)
      End If
      With .Cells(RowSrcCrnt, ColSrcCrnt)
        ValueList(InxVLCrntMax).Value = .Value              ' Version 2
        ValueList(InxVLCrntMax).Value = .Formula            ' Version 3
        ValueList(InxVLCrntMax).Colour = .Font.Color
      End With
      NumSelect = NumSelect + 7
    Loop
  End With
  With Sheets("Time2")
    For InxVLCrnt = 1 To InxVLCrntMax
      With .Cells(RowDestCrnt, ColDestCrnt)
        .Value = ValueList(InxVLCrnt).Value                 ' Version 2
        .Formula = ValueList(InxVLCrnt).Value               ' Version 3
        .Font.Color = ValueList(InxVLCrnt).Colour
      End With
      If ColDestCrnt = 20 Then
        ColDestCrnt = 1
        RowDestCrnt = RowDestCrnt + 1
      Else
       ColDestCrnt = ColDestCrnt + 1
      End If
    Next
  End With
  Debug.Print Timer - StartTime
  ' Version 2 average 1.47 secs
  ' Version 3 average 1.83 secs
  Application.Calculation = xlCalculationAutomatic

End Sub

просто используйте свойство NumberFormat после свойства Value: В этом примере диапазоны определяются с помощью переменных, называемых ColLetter и SheetRow, и это происходит из цикла for-next с использованием целого числа i, но они могут быть обычными определенными диапазонами, конечно.

лист передачи.Ряд (ColLetter & SheetRow).Value = диапазон (ColLetter & i).Значение TransferSheet.Ряд (ColLetter & SheetRow).NumberFormat = диапазон (ColLetter & i).NumberFormat

тут:

Set Sheets("Output").Range("$A:$A0") =  Sheets(sheet_).Range("$A:$A0")

...работа? (У меня нет Excel передо мной, поэтому я не могу проверить.)