在循环中使用Excel VBA转置动态值

时间:2017-03-30 23:15:05

标签: vba excel-vba loops transpose excel

我是excel VBA的新手,我需要帮助来弄清楚如何将值从一张纸转移到另一张纸。

以下是关于我的数据之前的数据以及我需要如何转换数据的图像:

在移居前

特征数量 | CLASS | CHAR 1 | CHAR 2 | CHAR 3 | CHAR 4 | CHAR 5 | CHAR 6 |
3 | ABSORBER | TYPE | SIZE | MATERIAL
5 | ADAPTER | TYPE | SIZE_A | CONNECTION_A | SIZE_B | CONNECTION_B    |材料

移位后

| CLASS | CHAR |
ABSORBER | TYPE
ABSORBER | SIZE
ABSORBER |材料
适配器|类型
适配器| SIZE_A
适配器| CONNECTION_A
适配器| SIZE_B
适配器| CONNECTION_B
适配器|材料

我有超过1000行需要转置的数据。

对不起,这是我能对桌子做的最好的事情。

1 个答案:

答案 0 :(得分:1)

我认为此功能将根据您问题中的示例数据运行。这假定了一些事情(" Count"是原始数据中的第一列,没有空白" Char"字段等等),所以我可以帮助您更准确地调整它场景如果需要。如果所有内容都在一个工作簿中,并且您不需要/想要将工作簿和工作表对象设置为变量,我们也可能会删除几行。

Public Sub Transpose()

Dim Row1 As Long
Dim Column1 As Long
Dim Row2 As Long
Dim CurrentWB As Workbook
Dim CurrentWS As Worksheet
Dim TransposeWB As Workbook
Dim TransposeWS As Worksheet
Dim CurrentClass As String

'Set workbook(s) and worksheets as variables just to make it easier to reference them
'Replace necessary workbooks and worksheets with what holds your actual data
Set CurrentWB = ActiveWorkbook
Set CurrentWS = CurrentWB.Worksheets("Sheet1")
Set TransposeWB = ActiveWorkbook
Set TransposeWS = CurrentWB.Worksheets("Sheet2")

'Set the starting row for the worksheet in which the transposed data will go
Row2 = 1

'Adjust as needed for the row in which your raw data starts and ends
For Row1 = 1 To 1000

    'Store the current class
    CurrentClass = CurrentWS.Cells(Row1, 2)

    'Assuming first "Char" column is 3
    Column1 = 3

    While CurrentWS.Cells(Row1, Column1) <> ""

        TransposeWS.Cells(Row2, 1) = CurrentClass
        TransposeWS.Cells(Row2, 2) = CurrentWS.Cells(Row1, Column1)

        'Move to the next "Char" column in untransposed sheet
        Column1 = Column1 + 1

        'Move to the next row in transposed sheet
        Row2 = Row2 + 1
    Wend

Next Row1

End Sub