在单个列中转换标题

我想转换列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