（VBA）Excel与成千上万的行 – 如何将可变长度列转置为行？
我有一个Excel工作表，我正在使用9948行。 一个单元格将包含多个信息，所以我迄今为止所做的是通过Excel的文本到列function来划分这些信息。
（所有数据和列标题是任意的）
它开始是这样的：
ID | Name | Property1 | 1 Apple JO18, GFBAJH, HFDH, 78EA 它的数据（混合文本/数字格式）在第一对应的列中，实际上应该在自己的行上。 其中一个属性的数量有所不同，所以一个可能有五个属性，另一个可能有20个。在对行进行分隔后，它看起来像这样：
ID | Name | Property1| Property2 | Property3 | Property4 | Property5 | Property6 | 1 Apple J012 B83A G5DD 2 Banana RETB 7CCV 3 Orange QWER TY YUIP CVBA UBBN FDRT 4 Pear 55V DWZA 6FJE LKOI PAKD 5 Cherry EEF AGC TROU
我一直在努力做到的是让它看起来像这样：
ID | Name | Property1| Property2 | Property3 | Property4 | Property5 | Property6 | 1 Apple J012 B83A G5DD 2 Banana RETB 7CCV 3 Orange QWER TY YUIP CVBA UBBN FDRT 4 Pear 55V DWZA 6FJE LKOI PAKD 5 Cherry EEF AGC TROU
我已经能够通过手动和转置每行的数据，这导致超过33,000行。 这非常耗费时间，我不怀疑我在这里和那里发生了一些错误，所以我想探索一种自动化的方法。
我已经探索了通过复制行，粘贴在底部，复制附加属性，并将它们置于Property1下方来loggingmacros，但是每次我尝试重复此操作时，它只粘贴到同一行，从不具有行的variables大小长度。 我已经在我试图增加1的macros中评论它，但是它给出了一个“types不匹配”的错误
录制的macros：
Sub Macro1() ' ' Macro1 Macro ' ' Keyboard Shortcut: Ctrl+Shift+A ' Selection.Copy ActiveWindow.ScrollRow = 9922 ActiveWindow.SmallScroll Down:=3 'Range("A9948").Value = Range("A9948").Value + 1 Range("A9948").Select ActiveSheet.Paste ActiveWindow.SmallScroll Down:=6 Range("E9948:Z9948").Select Application.CutCopyMode = False Selection.Copy Range("D9949").Select Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _ False, Transpose:=True End Sub
任何帮助，将不胜感激。
试试这个代码。 input范围是Apple到Cherry的第一列。
Set Rng = Sheets("sheet1").Range("B2:B6") 'Input range of all fruits Set Rng_output = Sheets("sheet2").Range("B2") 'Output range For i = 1 To Rng.Cells.Count Set rng_values = Range(Rng.Cells(i).Offset(0, 1), Rng.Cells(i).End(xlToRight)) 'For each fruit taking the values to the right which need to be transposed If rng_values.Cells.Count < 16000 Then 'To ensure that it doesnt select till the right end of the sheet For j = 1 To rng_values.Cells.Count Rng_output.Value = Rng.Cells(i).Value Rng_output.Offset(0, 1).Value = rng_values.Cells(j).Value Set Rng_output = Rng_output.Offset(1, 0) 'Shifting the output row so that next value can be printed Next j End If Next i
用input中显示的数据创build一个excel文件，逐步运行代码来理解它
这是你以后的结果吗？
Option Explicit Public Sub TransposeRows() Dim i As Long, j As Long, k As Long, ur As Variant, tr As Variant Dim thisVal As String, urMaxX As Long, urMaxY As Long, maxY As Long With Sheet1 ur = .UsedRange urMaxX = UBound(ur, 1) urMaxY = UBound(ur, 2) maxY = urMaxX * urMaxY ReDim tr(2 To maxY, 1 To 3) k = 2 For i = 2 To urMaxX For j = 2 To urMaxY thisVal = Trim(ur(i, j)) If Len(thisVal) > 0 Then If j = 2 Then tr(k, 1) = Trim(ur(i, 1)) tr(k, 2) = Trim(ur(i, 2)) tr(k, 3) = Trim(ur(i, 3)) j = j + 1 Else tr(k, 3) = thisVal End If k = k + 1 Else Exit For End If Next Next .UsedRange.Offset(1).Clear .Range(.Cells(2, 1), .Cells(maxY, 3)) = tr End With End Sub
之前 
后 