Копирование столбца в Excel и удвоение каждой записи / ячейки. Как?

Question

Допустим, у нас есть ряд элементов, 1 на ячейку: 1,2,3,4. Я хочу скопировать эту строку (или столбец) и удвоить каждую запись: 1,1,2,2,3,3,4,4.

Есть ли какая-нибудь формула, функция и т. Д., Которая это делает? Большое спасибо.

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

Answer 1

Например:

Формула в F1:

=INDEX($A1:$D1,1,ROUNDUP((COLUMN()-5)/2,0))

Перетащите вправо и вниз ...

Answer 2

Формула:

Результат:

Удерживать и перетаскивать по строкам

Answer 3

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

Option Explicit

Sub test()

    Dim LastRow As Long, i As Long, j As Long, LastColumn1 As Long, LastColumn2 As Long, Add1 As Long, Add2 As Long
    Dim str As String

    With ThisWorkbook.Worksheets("Sheet1")

        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row

        For i = 1 To LastRow

            LastColumn1 = .Cells(i, .Columns.Count).End(xlToLeft).Column

            For j = 1 To LastColumn1

                LastColumn2 = .Cells(i, .Columns.Count).End(xlToLeft).Column

                If LastColumn2 = LastColumn1 Then
                    Add1 = 2
                    Add2 = 3
                Else
                    Add1 = 1
                    Add2 = 2
                End If

                .Range(.Cells(i, LastColumn2 + Add1), .Cells(i, LastColumn2 + Add2)).Value = .Cells(i, j).Value

            Next j

        Next i

    End With

End Sub

Результаты:

Answer 4

Предполагается, что 1 в A1, и вы предпочитаете строки.

Чтобы не перетаскивать записи на 20 тыс., Я предлагаю в E1:

 =INDEX($A1:$D1,,INT((COLUMN()-3)/2))

перетащите на L1, а затем дважды щелкните маркер заполнения.

Answer 5

Простая альтернатива с использованием расширенных возможностей Application.Index()

Этот подход демонстрирует расширенные возможности реструктуризации функции ► Application.Index(), чьи строка и аргументы столбца передаются массивами вместо отдельных числовых индексов.

Основная процедура RedoubleCols

Эта процедура выполняется в два этапа:

1. присваивает данные 2-димному массиву на основе 1 v одной строкой кода,
2. реструктурирует весь массив через Application.Index, где строки и аргументы столбца являются массивами, возвращаемыми вспомогательными функциями AllRows() и RDC();результирующий массив записывается обратно в заданную цель.

Sub RedoubleCols(rng As Range, rng2 As Range)
' Purpose: get column values and write them back in pairs
' Param.:  1-rng: source range, 2-rng2: target range
' Method:  uses the advanced features of the Application.Index function
  Dim v                 ' declare variant (array)
' [1] get data
  v = rng.Value2
' [2] rearrange data by redoubling columns (RDC) and write them to a given target range
  rng2.Value2 = Application.Index(v, AllRows(UBound(v)), RDC(UBound(v, 2)))
End Sub

Вспомогательные функции, используемые главной процедурой выше

Function AllRows(ByVal n&) As Variant
' Purpose: create transposed Array(1,2,...n)
Dim i&: ReDim tmp(n - 1)
For i = 0 To n - 1
    tmp(i) = i + 1
Next i
AllRows = Application.Transpose(tmp)
End Function

Function RDC(ByVal n&) As Variant()
' Purpose: create Array(1,1,2,2,...n,n) containing pairs of each column number
Dim i&: ReDim tmp(2 * n - 1)                  ' declare counter and zero based counter array
For i = 0 To n - 1                            ' redouble column counters
    tmp(i * 2) = i + 1
    tmp(i * 2 + 1) = i + 1
Next i
RDC = tmp                                     ' return counter array
End Function

Пример вызова

Необходимыестрока кода в разделе [3] просто вызывает основную процедуру RedoubleCols:

RedoubleCols src, target

, где диапазон источника и целевой диапазон могут быть определены в соответствии с вашими потребностями - ср. разделы [1] и [2].

Sub ExampleCall()
' [1] Identify source range
  Dim src As Range
  Set src = ThisWorkbook.Worksheets("MySheet").Range("A1:D2")
' [2] define any target, e.g. 1 column to the right of source data
  Dim target As Range, r&, c&
  r = src.Rows.Count: c = src.Columns.Count
  Set target = src.Offset(0, c + 1).Resize(r, c * 2)    ' reserve double space for columns
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
' [3] write redoubled source range columns back to target
' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  RedoubleCols src, target
End Sub

Рекомендуемая ссылка

Лечение Некоторые особенности функции Application.Index