如何快速转换表格的格式？把部分横着的表转换成竖着的

一5483

求大神指点，我现在是用复制-转置黏贴，还有其他类似的数据，实在太多了，有没有什么办法可以快速转过来
工作簿1.zip (18.81 KB, 下载次数: 7)

2021-1-8 14:13 上传

点击文件名下载附件

苏小亓

透视表吧。

一5483

苏小亓 发表于 2021-1-8 14:24
透视表吧。

试过了，没成功，求指点

一5483

刚发现发错地方了，怎么才能删帖？

413191246se

* 楼主，请复制你的 EXCEL 数据到 Word 中，试用我为你编制的宏（因为不会 EXCEL 编程）。
* 请耐心等待，直到完成，再复制回 EXCEL，请自行检查校对；如果数据不对请弃用。

1. Sub MachineYear()
   
2.     Dim i&, r As Range, j&, k&, n&, DateNum&, MachNum&
   
3.     DateNum = ActiveDocument.Tables(1).Rows.Count - 1
   
4.     MachNum = ActiveDocument.Tables(1).Columns.Count - 1
   
5.     With Selection
   
6.         .EndKey 6
   
7.         .TypeText Text:="***"
   
8.         .Tables.Add Range:=.Range, NumRows:=DateNum * MachNum + 1, NumColumns:= _
   
9.         3, DefaultTableBehavior:=wdWord9TableBehavior, AutoFitBehavior:=wdAutoFitFixed
   
10.         .TypeText Text:="号机"
    
11.         .MoveRight 12
    
12.         .TypeText Text:="年月"
    
13.         .MoveRight 12
    
14.         .TypeText Text:="生产数"
    
15.         For j = 1 To DateNum
    
16.             For n = 1 To MachNum
    
17.                 i = i + 1
    
18.                 k = k + 1
    
19.                 If k > MachNum Then k = k - MachNum
    
20.                 With .Tables(1)
    
21.                     .Cell(i + 1, 1).Range.Text = Replace(ActiveDocument.Tables(1).Rows(1).Cells(k + 1).Range.Text, vbCr, "")
    
22.                     .Cell(i + 1, 2).Range.Text = Replace(ActiveDocument.Tables(1).Cell(j + 1, 1).Range.Text, vbCr, "")
    
23.                     .Cell(i + 1, 3).Range.Text = Replace(ActiveDocument.Tables(1).Cell(j + 1, n + 1).Range.Text, vbCr, "")
    
24.                 End With
    
25.             Next
    
26.         Next
    
27.     End With
    
28.     MsgBox "OK!", 0 + 48
    
29. End Sub

复制代码