Excel循环遍历列表，转置并根据单元格内容创buildmatrix

我正在接收一个大文件500k +行，但所有的内容都在A列。我需要运行一个macros，将数据转换为matrixforms，但只会在ActiveCell中find"KEY*"时创build一个新行。 例如：

 | KEY 4759839 | asljhk | 35049 | | sklahksdjf| | KEY 359 | skj | 487 |y| 2985789 | 

在我的文件中的上述数据最初看起来像A列：

 KEY 4759839 asljhk 35049 sklahksdjf KEY 359 skj 487 y 2985789 

注意事项：

• 空单元格也需要转置，所以macros不能基于emptyCell停止
• KEY之间的单元格数量不是常量，因此实际上需要读取单元格以确定是否应该创build一个新行
• 它可以基于连续20个空单元停止或提示最大行号
• （可选）如果某行的最后一个项目有某种视觉指示器，以便可以判断最后一个项目是否是空白单元格

我search了一下，发现了一个基本相同的macros，但是每6行都有一个macros，我不知道如何修改它。 但是，如果它在这里帮助，它是：

 Sub kTest() Dim a, w(), i As Long, j As Long, c As Integer a = Range([a1], [a500000].End(xlUp)) ReDim w(1 To UBound(a, 1), 1 To 6) j = 1 For i = 1 To UBound(a, 1) c = 1 + (i - 1) Mod 6: w(j, c) = a(i, 1) If c = 6 Then j = j + 1 Next i [c1].Resize(j, 6) = w End Sub 

我将不胜感激任何帮助，你可以给我！

Answer 1

经过testing和工作：

  Sub test() Row = 0 col = 1 'Find the last not empty cell by selecting the bottom cell and moving up Max = Range("A650000").End(xlUp).Row 'Or whatever the last allowed row number is 'loop through the data For i = 1 To Max 'Check if the left 3 characters of the cell are "KEY" and start a new row if they are If (Left(Range("A" & i).Value, 3) = "KEY") Then Row = Row + 1 col = 1 End If Cells(Row, col).Value = Range("A" & i).Value If (i > Row) Then Range("A" & i).Value = "" End If col = col + 1 Next i End Sub 

Answer 2

这与您在问题中提供的样本数据一起工作 – 它将结果输出到以B1开始的表格中。 在我的机器上运行500k行不到一秒钟。

 Sub kTest() Dim originalData As Variant Dim result As Variant Dim i As Long Dim j As Long Dim k As Long Dim countKeys As Long Dim countColumns As Long Dim maxColumns As Long originalData = Range([a1], [a500000].End(xlUp)) countKeys = 0 maxColumns = 0 'Calculate the number of lines and columns that will be required For i = LBound(originalData, 1) To UBound(originalData, 1) If Left(originalData(i, 1), 3) = "KEY" Then countKeys = countKeys + 1 maxColumns = IIf(countColumns > maxColumns, countColumns, maxColumns) countColumns = 1 Else countColumns = countColumns + 1 End If Next i 'Create the resulting array ReDim result(1 To countKeys, 1 To maxColumns) As Variant j = 0 k = 1 For i = LBound(originalData, 1) To UBound(originalData, 1) If Left(originalData(i, 1), 3) = "KEY" Then j = j + 1 k = 1 Else k = k + 1 End If result(j, k) = originalData(i, 1) Next i With ActiveSheet .Cells(1, 2).Resize(UBound(result, 1), UBound(result, 2)) = result End With End Sub