在excel中转​​置数据并制作自动表

Question

我有这样的数据：

想要这样：

但这应该自动完成，因为原始数据有超过2000行。我需要以我想要的方式装饰决赛桌。 （他们有边界居中，他们之间有空间......） 有什么建议吗？

Answer 1

我认为这样做，我不知道你想要写出来的地方。

Sub Create_List()

Dim Info() As Variant
Dim I, II, Ct As Long

Info = Range(Cells(1, 1), Cells(ActiveSheet.UsedRange.Rows.Count, ActiveSheet.UsedRange.Columns.Count)).Value

''Go where you want the list
ActiveSheet.Range("E1").Activate

Ct = 0

For I = 2 To UBound(Info, 1)
    For II = 1 To UBound(Info, 2)
      ActiveCell.Offset(Ct + II - 1, 0).Value = Info(1, II)
      ActiveCell.Offset(Ct + II - 1, 1).Value = Info(I, II)
    With ActiveCell.Offset(Ct + II - 1, 0).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 0).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 0).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 0).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

     With ActiveCell.Offset(Ct + II - 1, 1).Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 1).Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 1).Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With ActiveCell.Offset(Ct + II - 1, 1).Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With

    Next
    Ct = Ct + UBound(Info, 2) + 1
Next

End Sub