循环使用 Excel VBA 转置动态值

Question

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

以下是有关我之前的数据以及我如何需要转置数据的图像：

转置之前

特征计数|类|查尔 1|查尔 2|查尔 3|查尔 4|查尔 5|查尔 6|
3 |吸收剂 |类型 |尺寸 |材料
5 |适配器 |类型 |SIZE_A |CONNECTION_A |SIZE_B |CONNECTION_B |材料

转置后

|类|字符|
吸收剂 |
吸收器类型 |尺寸
吸收器 |材料
适配器 |类型
适配器 |SIZE_A
适配器 |CONNECTION_A
适配器 |SIZE_B
适配器 |CONNECTION_B
适配器 |材料

我有 1000 多行数据需要转置。

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

Answer 1

我认为这个函数将根据你问题中的示例数据工作。这假设了一些事情("计数"是原始数据中的第一列，没有空白的"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

结束子