arrays - 转换多列表并将输出转到两列？

Question

我正在寻找是否可以像示例图像中那样从表中获取数据和标题，并将输出转到两列，第一列是重复标题？我确实尝试过转置，但是电子邮件行一直填充到 E 列。

Answer 1

请尝试下一种方法。它使用数组即使在大范围内也很快，主要在内存中工作。它从“F2”开始返回。它能够处理您(可能)需要的任何其他列，在“状态”之后:

Sub TransposeMails()
 Dim sh As Worksheet, lastR As Long, lastCol As Long
 Dim arrH, arr, arrFin, i As Long, j As Long, k As Long
 
 Set sh = ActiveSheet 'use here the necessary sheet
 lastR = sh.Range("A" & sh.rows.count).End(xlUp).row          'last row
 lastCol = sh.cells(1, sh.Columns.count).End(xlToLeft).column 'last column 
 arrH = Application.Transpose(sh.Range(sh.cells(1, 1), sh.cells(1, lastCol)).Value2) 'place headers in an array
 arr = sh.Range("A2", sh.cells(lastR, lastCol)).Value2       'place the range to be processed (except headers) in an array for faster iteration/processing
 ReDim arrFin(1 To (UBound(arrH) + 1) * UBound(arr), 1 To 2) 'Redim the final array (keeping the processed result)
                                                             '+ 1 for the empty rows in between...

 For i = 1 To UBound(arr)
    For j = 1 To UBound(arrH)
        k = k + 1
        arrFin(k, 1) = arrH(j, 1): arrFin(k, 2) = arr(i, j)
    Next j
    k = k + 1 'for the empty row between groups...
 Next i
 
 'drop the processed array content:
 sh.Range("G2").Resize(UBound(arrFin), 2).Value2 = arrFin
End Sub

代码可以轻松调整以返回任何地方(另一张工作表、工作簿、范围等)。

要处理的范围必须从“A1”(“Email”标题)开始，并且在最后一个标题之后(在第一行)没有任何其他记录...