在单个列中转换标题

Question

我想在A列中转换我的所有数据标题

在：

后：

有人可以提供帮助吗？非常感谢！

Answer 1

我认为这可能适合你

Option Explicit

Sub Stackoverflow()

Dim LR As Integer
Dim LC As Integer
Dim LRR As Integer
Dim i As Integer
Dim j As Integer
Dim wss As Object
Dim Sht As Object
Dim wsr As Object
Dim CreateSheetIF As Boolean

Set wss = ActiveWorkbook.ActiveSheet

'Create a sheet for the results

Set Sht = Nothing
        On Error Resume Next
        Set Sht = ActiveWorkbook.Worksheets("Results")
        On Error GoTo 0

        If Sht Is Nothing Then

            CreateSheetIF = True
            Worksheets.Add.Name = "Results"
        Else
            GoTo Exist

        End If

Exist:

Set wsr = ActiveWorkbook.Sheets("Results")

LC = wss.Cells(1, Columns.Count).End(xlToLeft).Column

For i = 1 To LC
LR = wss.Cells(Rows.Count, i).End(xlUp).Row

For j = 1 To LR - 1
LRR = wsr.Cells(Rows.Count, 1).End(xlUp).Row
wsr.Range("A" & LRR + 1) = wss.Cells(1, i)
wsr.Range("B" & LRR + 1) = wss.Cells(j + 1, i)
Next


Next

End Sub

我没有花很多时间做这件事。所以代码根本不是很好。 但它应该工作。 结果将粘贴在名为“结果”的新工作表上。

Answer 2

也许：

Sub ReOrganize()
Dim MaxCol As Long, Ic As Long, H As Variant
Dim s1 As Worksheet, s2 As Worksheet
Dim MaxRow As Long, K As Long, Jr As Long
Set s1 = Sheets("Sheet1")
Set s2 = Sheets("Sheet2")
MaxCol = s1.Cells(1, Columns.Count).End(xlToLeft).Column
For Ic = 1 To MaxCol
    H = s1.Cells(1, Ic).Value
    MaxRow = s1.Cells(Rows.Count, Ic).End(xlUp).Row
    K = 2 * Ic - 1
    For Jr = 2 To MaxRow
        s2.Cells(Jr - 1, K) = H
        s2.Cells(Jr - 1, K + 1) = s1.Cells(Jr, Ic).Value
    Next Jr
Next Ic
End Sub