Question

我有一张Excel表格，我正在使用9948行。一个单元格中包含多条信息，所以我到目前为止所做的是通过Excel的文本到列功能划分它们。

（所有数据和列标题都是任意的）

它是这样开始的：

 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下面，但每次我尝试重复它时它只会粘贴到同一行并且永远不会有变量大小调整行长度。我已经在我尝试增加1的宏中对它进行了评论，但它给出了“类型不匹配”错误

录制的宏：

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

任何帮助将不胜感激。

Answer 1

试试这段代码。输入范围是从Apple到Cherry的第一列。

GetNumber()

使用输入中显示的数据创建一个excel文件，并逐步运行代码以理解它

Answer 2

这是你追求的结果吗？

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

在

（VBA）包含数千行的Excel - 如何将可变长度列转换为行？

2 个答案: