Объединение / использование формата VBA занимает слишком много времени

Question

Я хочу перебрать столбец в диапазоне и объединить дату и число для генерации идентификатора. Проблема в том, что в ячейке, содержащей дату, также указывается время, а сейчас я использую Format(datum.Cells(1, 1), "dd/mm/yyyy"), однако для его обработки требуется много времени. Есть ли способ ускорить это?

For Each datum In Range(rngDestination.Cells(1, 14), 
 rngDestination.Cells(lastRow, 14))
       If Not datum.Value = "" Then
         datum.Cells(1, 10).Value = Format(datum.Cells(1, 1), "dd/mm/yyyy")
       End If
Next datum
 For Each kette In Range(rngDestination.Cells(1, 1), 
 rngDestination.Cells(lastRow, 1))
  kette.Cells(1, 0).Value = kette.Cells(1, 23).text& & kette.Cells(1, 5).text
Next kette

Answer 1

Попробуйте сразу собрать его в массив, а затем сбросить значения обратно.

dim arr as variant, tmp as variant, i as long

with rngDestination
    arr = .Range(rngDestination.Cells(1, 14),  rngDestination.Cells(lastRow, 14)).value2
    tmp = .Range(rngDestination.Cells(1, 5),  rngDestination.Cells(lastRow, 5)).value2
    for i =lbound(arr, 1) to ubound(arr, 1)
        if cbool(len(arr(i, 1))) then
            arr(i, 1) = int(arr(i, 1))
        else
            arr(i, 1) = vbnullstring
        end if
    next i
    .Cells(1, 23).resize(ubound(arr, 1), ubound(arr, 1)) = arr
    .Cells(1, 23).resize(ubound(arr, 1), ubound(arr, 1)).numberformat = "dd/mm/yyyy"
    for i =lbound(arr, 1) to ubound(arr, 1)
        arr(i, 1) = format(arr(i, 1), "dd/mm/yyyy") & tmp(i, 1)
    next i
    .Cells(1, 0).resize(ubound(arr, 1), ubound(arr, 1)) = arr
end with

Answer 2

Работа с массивами и типизированными функциями? Не проверено.

 Dim rng As Range, arr(), i As Long
 Set rng = Range(rngDestination.Cells(1, 14), rngDestination.Cells(lastRow, 14))

 arr = rng.Value
 For i = LBound(arr, 1) To UBound(arr, 1)
   If Not IsEmpty(arr(i, 1)) Then
       arr(i, 1) = Format$(arr(i, 1), "dd/mm/yyyy")
   End If
 Next

 rng = Application.WorksheetFunction.Transpose(Application.WorksheetFunction.Index(arr, 0, 1))