[已解决]竖排数据转换为横排

wenwen000424

将订阅清单中的数据格式转换为收发清单的形式。 求助.rar (4.9 KB, 下载次数: 21)

2012-11-20 08:13 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

开辆小富康

2012-11-21 10:14

1,将源数据按现在格式，复制到结果文件中，工作表命名为  "源数据"
2,将结果工作表，命名为“结果"
当然你可以将上述名称改变，代码中作相应改动

Sub MyTranspose()
Dim Sh As Worksheet
Set Sh = Sheets("源数据")
With Sheets("结果")
   .Range("a4").Resize(.Rows.Count - 3, .Columns.Count).ClearContents
   Sh.Columns("a:b").Sort Sh.Range("a2"), Header:=xlYes
   j = 3

   For i = 2 To Sh.Range("a" & Rows.Count).End(3).Row
     If Sh.Cells(i, 1) <> Sh.Cells(i - 1, 1) Then
       j = j + 1
       col = 1
       .Cells(j, col) = Sh.Cells(i, 1)
     End If
     col = col + 1
     .Cells(j, col) = Sh.Cells(i, 2)
   Next i
End With
End Sub

跳转到最佳答案楼层

wayy

看一下吧。                                         

hwc2ycy

转置嘛。工作表函数transpose.

wenwen000424

谢谢两位的关注！我想要VBA的。

我心飞翔410

wenwen000424 发表于 2012-11-20 09:34
谢谢两位的关注！我想要VBA的。

录制宏啊  复制-选择性粘贴 转置 看宏代码 自己在修改哈啊

wenwen000424

我心飞翔410 发表于 2012-11-20 10:13
录制宏啊  复制-选择性粘贴 转置 看宏代码 自己在修改哈啊

录制宏代码不简洁，谢谢关注！

开辆小富康

1,将源数据按现在格式，复制到结果文件中，工作表命名为  "源数据"
2,将结果工作表，命名为“结果"
当然你可以将上述名称改变，代码中作相应改动

Sub MyTranspose()
Dim Sh As Worksheet
Set Sh = Sheets("源数据")
With Sheets("结果")
   .Range("a4").Resize(.Rows.Count - 3, .Columns.Count).ClearContents
   Sh.Columns("a:b").Sort Sh.Range("a2"), Header:=xlYes
   j = 3

   For i = 2 To Sh.Range("a" & Rows.Count).End(3).Row
     If Sh.Cells(i, 1) <> Sh.Cells(i - 1, 1) Then
       j = j + 1
       col = 1
       .Cells(j, col) = Sh.Cells(i, 1)
     End If
     col = col + 1
     .Cells(j, col) = Sh.Cells(i, 2)
   Next i
End With
End Sub