excel - 以特定格式转置

Question

今天我完成了 VBA 类(class)的循环部分，并做了一些练习，但我遇到了一个我似乎无法解决的问题。

我想将数据从工作表 1 转置到工作表 2。

表 1

a   1   2   3
b   1   2   3   4   5   6
c   1   2   3   4

我正在尝试编写一个宏，将数据转置到 Sheet 2 中，如下所示:

a   1
a   2
a   3
b   1
b   2
b   3
b   4
b   5
b   6
c   1
c   2
c   3
c   4

我尝试编写一些 VBA 代码，但我不知道如何解决这个特定问题。我尝试使用 Do Until 循环，但遇到的问题是如何将工作表 1 第 1 列中的字母与工作表 2 中相应的数字粘贴在一起。

一位 friend 做了一些代码让我分析，但这让我更加困惑。它适用于该数据集，但无法处理更大的数据集(其中字母变为“z”)。

这是他的代码:

Sub transpose()
    Sheets(1).Select

    lrow1 = Cells(Rows.Count, 1).End(xlUp).Row

    For i = 1 To lrow1
        nums = 2

        Cells(i, nums).Select

        Do Until IsEmpty(ActiveCell)
            nums = nums + 1
            Cells(i, nums).Select
        Loop

        Range(Cells(i, 2), Cells(i, nums)).Copy
        Sheets(2).Select

        lrow2 = Cells(Rows.Count, 2).End(xlUp).Row

        Cells(lrow2 + 1, 2).Select

        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, transpose:=True

        Sheets(1).Select

        Cells(i, 1).Copy

        Sheets(2).Select

        Cells(lrow2 + 1, 1).Select

        Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
            False, transpose:=False

        lrow3 = Cells(Rows.Count, 2).End(xlUp).Row

        Cells(lrow2 + 1, 1).Select

        Selection.AutoFill Destination:=Range(Cells(lrow2 + 1, 1), Cells(lrow3, 1)), Type:=xlFillDefault

        Sheets(1).Select
    Next i

    Sheets(2).Select

    Rows("1:1").Select

    Selection.Delete Shift:=xlUp
End Sub

https://pastebin.com/J45fmYKj

Answer 1

这将为您做...

Public Sub TransformData()
    Dim lngRow As Long, lngEndRow As Long, objSrcSheet As Worksheet, objDestSheet As Worksheet
    Dim strLetter As String, strNumber As String, lngCol As Long, lngWriteRow As Long

    Set objSrcSheet = Sheet1
    Set objDestSheet = Sheet2

    lngEndRow = objSrcSheet.Range("A" & objSrcSheet.Rows.Count).End(xlUp).Row

    With objSrcSheet
        For lngRow = 1 To lngEndRow
            strLetter = .Cells(lngRow, 1)

            If strLetter <> "" Then
                For lngCol = 2 To .Columns.Count
                    strNumber = .Cells(lngRow, lngCol)

                    If strNumber = "" Then Exit For

                    lngWriteRow = lngWriteRow + 1

                    objDestSheet.Cells(lngWriteRow, 1) = strLetter
                    objDestSheet.Cells(lngWriteRow, 2) = strNumber
                Next
            End If
        Next
    End With
End Sub

...我决定给你一个完整的解决方案。对或错，最好或最坏，这就是我会做的，鉴于你正在学习，我希望它对你有帮助。它还采用了一种不使用 SELECT 的方法，这只会减慢您的速度，并且被认为是极其糟糕的做法。

它假设我的源工作表如下图所示。我希望这会有所帮助。