excel宏从excel表中获取特定格式的数据

时间:2017-02-15 00:47:42

标签: excel excel-vba vba

非常感谢您使用可以让我的生活更轻松的宏的帮助。

我有这种格式的数据:

source table

并且需要一个宏来在另一个表中转换它,如下所示:

output table

1 个答案:

答案 0 :(得分:0)

这是宏 -

Sub perform()
Application.ScreenUpdating = False

Sheets("Sheet2").Range("A2:D50000").ClearContents

Dim rowcount, datacount, lastrow As Integer
rowcount = Sheets("Sheet1").Range("A500000").End(xlUp).Row
datacount = Sheets("Sheet1").Range(Sheets("Sheet1").Range("H5"), Sheets("Sheet1").Range("H5").End(xlToRight)).Count

Sheets("Sheet2").[A2] = "Code"
Sheets("Sheet2").[B2] = "Ref"
Sheets("Sheet2").[C2] = "Amount"
Sheets("Sheet2").[D2] = "Quantity"


For i = 5 To rowcount

lastrow = Sheets("Sheet2").Range("A500000").End(xlUp).Row + 1
Sheets("Sheet2").Range("A" & lastrow & ":A" & lastrow + datacount - 1).Value = Sheets("Sheet1").Range("A" & i).Value
Sheets("Sheet1").Range("H4:L4").Copy
Sheets("Sheet2").Range("B" & lastrow & ":B" & lastrow + datacount - 1).PasteSpecial Transpose:=True
Sheets("Sheet1").Range("H" & i & ":L" & i).Copy
Sheets("Sheet2").Range("C" & lastrow & ":C" & lastrow + datacount - 1).PasteSpecial Transpose:=True

Sheets("Sheet1").Range("G" & i).Copy Sheets("Sheet2").Range("D" & lastrow)

Next i

Application.ScreenUpdating = True
End Sub