如何将表格形式的数据转换成最基础形式的数据

韬韬他妈

各位老师，最近工作中，老是出现需要将表格形式的数据转换成基础数据进行导入，因为数据量较大，重复度较高
请老师帮我设计一个小程序，让我一点按钮，就形成效果图的数据。谢谢


原始附件
表格形式的数据转换成基础数据.rar (9.29 KB, 下载次数: 2)

2015-8-12 20:54 上传

点击文件名下载附件

已解决  附件

看见星光

1. Sub d()
   
2. Dim arr, brr, i&, j&, k&
   
3. arr = [a1].CurrentRegion
   
4. ReDim brr(1 To Cells.Rows.Count, 1 To 3)
   
5.     For j = 2 To UBound(arr, 2)
   
6.         For i = 2 To UBound(arr)
   
7.             If arr(i, j) <> "" Then
   
8.                 k = k + 1
   
9.                 brr(k, 1) = arr(1, j)
   
10.                 brr(k, 2) = arr(i, 1)
    
11.                 brr(k, 3) = arr(i, j)
    
12.             End If
    
13.         Next
    
14.     Next
    
15.     With Sheets("结果")
    
16.         .Cells.ClearContents
    
17.         .[a2].Resize(k, 3) = brr
    
18.         .[a1:c1] = Array("部门", "项目", "数量")
    
19.         .Select
    
20.     End With
    
21. End Sub
    

复制代码

看见星光

附件供参考 100.zip (18.32 KB, 下载次数: 16)

2015-8-12 21:05 上传

点击文件名下载附件

韬韬他妈

看见星光 发表于 2015-8-12 21:05
附件供参考

谢谢老师，正是我要的效果，帮了我很大的忙

zax010

Sub zz()
    Dim d, ar
    Set d = CreateObject("Scripting.Dictionary")
    ar = Sheet1.Range("A1").CurrentRegion
    For j = 2 To UBound(ar, 2)
        For i = 2 To UBound(ar)
            If ar(i, j) <> "" Then d(ar(1, j) & "," & ar(i, 1)) = ar(i, j)
        Next
    Next
    With Sheet2
        .[a2:c100].ClearContents
        For Each k In d.keys
            .Cells(2 + n, 1).Resize(1, 2) = Split(k, ",")
            .Cells(2 + n, 3) = d(k)
            n = n + 1
        Next
    End With
End Sub

zax010

>>>>>>>>>>>>>>>>>>>>>>>>

表格形式的数据转换成基础数据.rar (16.99 KB, 下载次数: 2)

2015-8-12 21:22 上传

点击文件名下载附件