Question

我为此寻找了一些伪代码，但找不到它。任何帮助，将不胜感激。基本上我想采样样本数据：

1 A     2 B    3 C
4 D     5 E    6 F

并将其复制到新工作表中：

 1 A
 2 B
 3 C
 4 D
 5 E
 6 F

Answer 1

根据你的图片，我们正在复制工作表中的所有内容。这适用于该案例。如果它是一个子集，请尝试修改rngSource以满足您的需求：

Sub FlattenAndCopy()
Dim wsSource As Excel.Worksheet
Dim rngSource As Excel.Range
Dim varSource As Variant
Dim wsTarget As Excel.Worksheet
Dim SourceCount As Long
Dim varTarget() As Variant
Dim i As Long, j As Long

Set wsSource = ActiveSheet
Set rngSource = wsSource.UsedRange
varSource = rngSource.Value
SourceCount = rngSource.Cells.Count
ReDim varTarget(1 To SourceCount)
For i = LBound(varSource, 1) To UBound(varSource, 1)
    For j = LBound(varSource, 2) To UBound(varSource, 2)
        varTarget((i - 1) * (UBound(varSource, 2)) + j) = varSource(i, j)
    Next j
Next i
Set wsTarget = wsSource.Parent.Worksheets.Add
wsTarget.Cells(1).Resize(SourceCount, 1) = Application.WorksheetFunction.Transpose(varTarget)
End Sub

按时间顺序将多个列复制到另一个工作表中

1 个答案: