如何将N多列数据转置为行，而对应的标题也一起复制

hhak003

有很多类似下面的这种数据

需要转换成下面这种格式

希望大神们帮帮忙教一下怎么处理~量很大手动处理会崩溃的~

zhjlgaojuan

Sub test()
Dim SourceArr
Dim TargetArr()
SourceArr = Range("a1:l9")
ReDim TargetArr(1 To UBound(SourceArr) * (UBound(SourceArr, 2) - 1), 1 To 2)
For i = 1 To UBound(SourceArr)
    For j = 2 To UBound(SourceArr, 2)
        If SourceArr(i, j) <> "" Then
            Y = Y + 1
            TargetArr(Y, 1) = SourceArr(i, 1)
            TargetArr(Y, 2) = SourceArr(i, j)
        End If
    Next
Next
[a14].Resize(Y, 2) = TargetArr
End Sub

hhak003

zhjlgaojuan 发表于 2018-7-17 10:13
Sub test()
Dim SourceArr
Dim TargetArr()

太厉害了~~谢谢~！能不能让做好的数据 放在新表里面

dancefly09

用VBA实现的话，如下所示这样的：

1. Sub 提取数据()
   
2.     For i = 2 To 10
   
3.         For j = 2 To 12
   
4.             If Cells(i, j) <> "" Then
   
5.                 jsh = [P65535].End(xlUp).Row
   
6.                 Cells(jsh + 1, "P") = Cells(i, 1)
   
7.                 Cells(jsh + 1, "Q") = Cells(i, j)
   
8.             End If
   
9.         Next j
   
10.     Next i
    
11. End Sub

复制代码

但是建议用数据透视表的多重合并计算区域功能来处理，非常简单方便，几秒钟的事情，不需要用代码。
实验室-透视表实现.zip (208.93 KB, 下载次数: 58)

2018-7-17 10:27 上传

点击文件名下载附件

蓝桥玄霜

请见代码。

chaohuahch

hhak003 发表于 2018-7-17 10:20
太厉害了~~谢谢~！能不能让做好的数据 放在新表里面

[a14].Resize(Y, 2) = TargetArr 你只需要把这一句，加上一个新工作表的前缀，就可以了

hhak003

dancefly09 发表于 2018-7-17 10:23
用VBA实现的话，如下所示这样的：

我想说如果列数不能确定呢

dancefly09

hhak003 发表于 2018-7-17 10:36
我想说如果列数不能确定呢

1. Sub 提取数据()
   
2.     For i = 2 To Cells(Cells.Rows.count, 1).End(xlUp).Row
   
3.         For j = 2 To Cells(i, Cells.Columns.count).End(xlToLeft).Column
   
4.             If Cells(i, j) <> "" Then
   
5.                 jsh = Worksheets("结果").Cells(Cells.Rows.count, 1).End(xlUp).Row
   
6.                 Worksheets("结果").Cells(jsh + 1, "A") = Cells(i, 1)
   
7.                 Worksheets("结果").Cells(jsh + 1, "B") = Cells(i, j)
   
8.             End If
   
9.         Next j
   
10.     Next i
    
11. End Sub

复制代码

hhak003

dancefly09 发表于 2018-7-17 10:23
用VBA实现的话，如下所示这样的：

厉害啊~这个事情上~你这个方法比VBA实用很多~受教了~