Excel VBA Do-Loop для копирования и вставки с целью заполнения пустых ячеек в каждой строке

Excel VBA Do-Loop для копирования и вставки с целью заполнения пустых ячеек в каждой строке

Мне нужна помощь в том, как применить подходящий цикл Excel VBA do-loop или иным образом скопировать содержимое ячейки и вставить следующий набор пустых ячеек в каждой строке. По мере того, как он проходит по каждой строке, он копирует и вставляет только следующие пустые ячейки и снова копирует содержимое следующей заполненной ячейки и вставляет в следующие пустые ячейки, пока каждая строка не будет заполнена. Мне нужно применить это к таблице, содержащей около 5000 строк. Любая помощь будет высоко оценена. Исходная таблица и ожидаемый результат таблицы должны выглядеть следующим образом: Образцы таблиц

решение1

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

Sub SuperUserHelp()

  Dim TempArray As Variant, x As Long, y As Long
  Dim ValueNow As Variant, SheetName As String, TableAddress As String

  SheetName = "Sheet1"   'Set your sheet name here
  TableAddress = "A1:E5" 'Set your table range here

  TempArray = Sheets(SheetName).Range(TableAddress).Value

  For x = 1 To UBound(TempArray, 1)

    ValueNow = Empty 'new row defaults to

    For y = 1 To UBound(TempArray, 2)
      If TempArray(x, y) = Empty Then
        TempArray(x, y) = ValueNow
      Else
        ValueNow = TempArray(x, y)
      End If
    Next y

  Next x

  Sheets(SheetName).Range(TableAddress).Value = TempArray

End Sub

Связанный контент