Question

假设我们有一排元素，每个单元格1、1、2、3、4。我想复制此行（或列），然后将每个条目加倍：1,1,2,2,3,3,4,4。

是否有任何公式，函数等可以执行此操作？非常感谢。

我大约有2万个条目，因此手动选择是不可能的。

Answer 1

例如：

F1中的公式：

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

左右拖动...

Answer 2

您可以使用：

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 3

公式：

结果：

按住并拖动行

Answer 4

使用Application.Index()

的高级可能性的简便选择

此方法演示了►Application.Index()函数的高级重组可能性，该函数的行和列参数由数组提供单个数字索引。

主要过程RedoubleCols

此过程执行两个步骤：

它通过一条代码行将数据分配给基于1的2维数组v，
它通过Application.Index重组整个数组，其中 row 和 column参数是辅助函数AllRows()和{{1}返回的数组};结果数组被写回到给定的目标。

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

可以根据需要定义源范围和目标范围-c.f. RedoubleCols src, target和[1]部分。

[2]

推荐链接

对待Some peculiarities of the the Application.Index function

Answer 5

假设1位于A1中并且您希望使用行。

为了避免向下拖动2万个条目，我建议在E1中使用

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

拖到L1，然后双击填充手柄。

在excel中复制一列，并将每个条目/单元格加倍。如何？

5 个答案: