Когда строки данных копируются в новое место, данные копируются правильно, но пустые строки вставляются между строками данных

Question

Я новичок в VBA.

В нескольких местах на листах рабочей книги у меня есть 4 столбца данных.Они не всегда находятся в одних и тех же столбцах, и диапазон может начинаться в разных строках.Первая строка всегда содержит одинаковые заголовки (идентификатор, описание, время, категория).Данные в столбце 3 (времена) диапазона всегда являются числами.То, чего я пытаюсь добиться, - это скопировать каждую строку в диапазоне данных, который я выбрал, в новое место, количество раз, указанное в столбце 3 (строки со значением «0» копируются один раз).

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

Код, который я написал, кажется, отлично работает, если пункт назначениякопирование в начинается в строке 1. Если мой пункт назначения начинается в любой другой строке, информация копируется правильно, но пустые строки вставляются между каждой строкой скопированных данных.Количество пустых строк варьируется и, по-видимому, зависит от строки, назначенной для начала копирования выходных данных (т. Е. Если выходные существа в строке 2 - 1 вставляют пустую строку между каждой строкой данных; если вывод начинается в строке 3 - 2пустые строки вставляются между каждой строкой данных, если вывод начинается в строке 4 - 3 пустых строки вставляются между строками данных и т. д.).

Обычно в столбцах по обе стороны от моего выходного пункта назначения находятся данные, и данные в этих столбцах также могут находиться в строках выше или ниже моего выходного пункта назначения.(То есть, если мое назначение вывода - F4: I10, возможно, в A1: D7 и K9: L34 уже могут быть данные)Предлагаемые решения.

Пример моих данных и желаемого результата:

Вот код, с которым я работал.

Sub expandedcopy()

Dim source As Range
Dim destination As Range
Dim i As Integer, n As Integer
Dim ws As Worksheet
Dim lastblankrow As Long



Set source = Application.InputBox("Select the entire table (including headers) to extrapolate", Type:=8)

Set destination = Application.InputBox("Select the upper-left cell location to which your data will be coppied.  4 rows to the right are required", Type:=8)

destination.Offset(0, 0).Value = "ID"
destination.Offset(0, 1).Value = "Description"
destination.Offset(0, 2).Value = "Times"
destination.Offset(0, 3).Value = "Category"
StartRow = 2
usedRowsSrc = source.Rows.Count - 1

For i = StartRow To usedRowsSrc
  strID = source.Cells(i, 1).Value
  strDescription = source.Cells(i, 2).Value
  strTimes = source.Cells(i, 3).Value
  strCategory = source.Cells(i, 4).Value
  iTimes = source.Cells(i, 3).Value + 1

Set ws = destination.Worksheet

ws.Activate

  For j = 1 To iTimes
    lastblankrow = Cells(Rows.Count, destination.Column).End(xlUp).Row
    With destination
      .Offset(lastblankrow, 0).Value = strID
      .Offset(lastblankrow, 1).Value = strDescription
      .Offset(lastblankrow, 2).Value = strTimes
      .Offset(lastblankrow, 3).Value = strCategory
    End With
  Next

Next

End Sub

Answer 1

Вот более простой подход, при котором каждая строка копируется необходимое количество раз.

Sub expandedcopy()

Dim source As Range, destination As Range, i As Long, j As Long, n As Long

Set source = Application.InputBox("Select the entire table (including headers) to extrapolate", Type:=8)
Set destination = Application.InputBox("Select the upper-left cell location to which your data will be coppied.  4 rows to the right are required", Type:=8)

destination.Resize(, source.Columns.Count).Value = source.Rows(1).Value
j = 1

For i = 2 To source.Rows.Count
    n = source.Cells(i, 3).Value + Abs(source.Cells(i, 3).Value = 0)
    source.Cells(i, 1).Resize(, 4).Copy destination.Resize(n).Offset(j)
    j = j + n
Next i

End Sub