使用VBA将垂直表中的数据更改为各行

Question

我有一个Excel工作簿，格式如下：

  | A  | B     | C     | D     | E     |   
  |----|-------|-------|-------|-------|  
 1|    | po#1  | po#2  | po#3  | po#1  |
 2|    | date1 | date2 | date3 | date4 |
 3|sku1| qty1  | qty4  | qty7  | qty10 | 
 4|sku2| qty2  | qty5  | qty8  | qty11 |
 5|sku3| qty3  | qty6  | qty9  | qty12 |

我需要转换为以下格式：

  | A      | B     | C     | D     |
  |--------|-------|-------|-------|
 1|  po#1  | date1 | sku1  | qty1  |
 2|  po#1  | date1 | sku2  | qty2  |
 3|  po#1  | date1 | sku3  | qty3  |
 4|  po#1  | date4 | sku1  | qty10 |
 5|  po#1  | date4 | sku2  | qty11 |
 6|  po#1  | date4 | sku3  | qty12 |
 7|  po#2  | date2 | sku1  | qty4  |
 8|  po#2  | date2 | sku2  | qty5  |
 9|  po#2  | date2 | sku3  | qty6  |
10|  po#3  | date3 | sku1  | qty7  |
11|  po#3  | date3 | sku2  | qty8  |
12|  po#3  | date3 | sku3  | qty9  |

使用VBA。

Answer 1

如果您的标题全部包含在第1：2行和A列：A中，那么您可以使用以下代码：

Dim sht1 As Worksheet, sht2 As Worksheet
Dim cel As Range
Dim rowWrite As Long

rowWrite = 1
Set sht1 = ActiveSheet
Set sht2 = ActiveWorkbook.Worksheets.Add
For Each cel In sht1.Range("B3", sht1.Range("B2").End(xlToRight).End(xlDown).Address)
    With sht2.Range("A" & rowWrite)
        .Offset(, 0).Value = cel.EntireColumn.Resize(1).Value
        .Offset(, 1).Value = cel.EntireColumn.Resize(1).Offset(1).Value
        .Offset(, 2).Value = cel.EntireRow.Resize(1).Value
        .Offset(, 3).Value = cel.Value
    End With
    rowWrite = rowWrite + 1
Next cel

这将创建一个新工作表并将数据写入该工作表。 它不会保留格式，如果您需要，请告诉我。

希望这有帮助。